From 41a2f2791521b332804830f1d8e03834bfb84262 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sat, 9 Dec 2017 21:54:08 -0600 Subject: [PATCH 01/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/channel_surface_forcing.F90 new file: config_src/solo_driver/shoebox_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 modified: src/initialization/MOM_state_initialization.F90 new file: src/user/bowlhk_initialization.F90 new file: src/user/box_initialization.F90 new file: src/user/channel3_initialization.F90 new file: src/user/channel_initialization.F90 new file: src/user/channels_initialization.F90 new file: src/user/channelssp_initialization.F90 new file: src/user/shoebox_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 18 + .../solo_driver/channel_surface_forcing.F90 | 266 +++++++++++++++ .../solo_driver/shoebox_surface_forcing.F90 | 302 ++++++++++++++++ .../MOM_fixed_initialization.F90 | 21 ++ .../MOM_state_initialization.F90 | 12 + src/user/bowlhk_initialization.F90 | 105 ++++++ src/user/box_initialization.F90 | 72 ++++ src/user/channel3_initialization.F90 | 195 +++++++++++ src/user/channel_initialization.F90 | 322 ++++++++++++++++++ src/user/channels_initialization.F90 | 183 ++++++++++ src/user/channelssp_initialization.F90 | 184 ++++++++++ src/user/shoebox_initialization.F90 | 217 ++++++++++++ 12 files changed, 1897 insertions(+) create mode 100644 config_src/solo_driver/channel_surface_forcing.F90 create mode 100644 config_src/solo_driver/shoebox_surface_forcing.F90 create mode 100644 src/user/bowlhk_initialization.F90 create mode 100644 src/user/box_initialization.F90 create mode 100644 src/user/channel3_initialization.F90 create mode 100644 src/user/channel_initialization.F90 create mode 100644 src/user/channels_initialization.F90 create mode 100644 src/user/channelssp_initialization.F90 create mode 100644 src/user/shoebox_initialization.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 8f4fce6b88..099c4508d8 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -79,6 +79,10 @@ module MOM_surface_forcing use MESO_surface_forcing, only : MESO_surface_forcing_init, MESO_surface_forcing_CS use Neverland_surface_forcing, only : Neverland_wind_forcing, Neverland_buoyancy_forcing use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS +use shoebox_surface_forcing, only : shoebox_wind_forcing, shoebox_buoyancy_forcing +use shoebox_surface_forcing, only : shoebox_surface_forcing_init, shoebox_surface_forcing_CS +use channel_surface_forcing, only : channel_wind_forcing, channel_buoyancy_forcing +use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -204,6 +208,8 @@ module MOM_surface_forcing type(BFB_surface_forcing_CS), pointer :: BFB_forcing_CSp => NULL() type(MESO_surface_forcing_CS), pointer :: MESO_forcing_CSp => NULL() type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL() + type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() + type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() @@ -290,6 +296,10 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call MESO_wind_forcing(sfc_state, forces, day_center, G, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox") then + call shoebox_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox_forcing_CSp) + elseif (trim(CS%wind_config) == "channel") then + call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then @@ -322,6 +332,10 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call MESO_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%MESO_forcing_CSp) elseif (trim(CS%buoy_config) == "Neverland") then call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%Neverland_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox") then + call shoebox_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel") then + call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then @@ -1805,6 +1819,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call MESO_surface_forcing_init(Time, G, param_file, diag, CS%MESO_forcing_CSp) elseif (trim(CS%wind_config) == "Neverland") then call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox") then + call shoebox_surface_forcing_init(Time, G, param_file, diag, CS%shoebox_forcing_CSp) + elseif (trim(CS%wind_config) == "channel") then + call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then diff --git a/config_src/solo_driver/channel_surface_forcing.F90 b/config_src/solo_driver/channel_surface_forcing.F90 new file mode 100644 index 0000000000..f13fcf7fcc --- /dev/null +++ b/config_src/solo_driver/channel_surface_forcing.F90 @@ -0,0 +1,266 @@ +!> Wind and buoyancy forcing for the channel configurations +module channel_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel_wind_forcing +public channel_buoyancy_forcing +public channel_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the channel forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel_buoyancy_forcing has been called +end type channel_surface_forcing_CS + +contains + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel forcing configuration. +subroutine channel_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel_wind_forcing + + +!> Surface fluxes of buoyancy for the channel configurations. +subroutine channel_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1027.459, rhon = 1025.335 ! sothern and northern boundary densities of the channel + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel control structure. +subroutine channel_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + +end module channel_surface_forcing diff --git a/config_src/solo_driver/shoebox_surface_forcing.F90 b/config_src/solo_driver/shoebox_surface_forcing.F90 new file mode 100644 index 0000000000..9feeb13a8c --- /dev/null +++ b/config_src/solo_driver/shoebox_surface_forcing.F90 @@ -0,0 +1,302 @@ +!> Wind and buoyancy forcing for the shoebox configurations +module shoebox_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox_wind_forcing +public shoebox_buoyancy_forcing +public shoebox_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox_buoyancy_forcing has been called +end type shoebox_surface_forcing_CS + +contains + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox forcing configuration. +subroutine shoebox_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox_wind_forcing + + +!> Surface fluxes of buoyancy for the shoebox configurations. +subroutine shoebox_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1027.459, rho2 = 1023.303, rho3 = 1027.093 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox control structure. +subroutine shoebox_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox_surface_forcing diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index f38f29ae46..b104fc928c 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -31,6 +31,13 @@ module MOM_fixed_initialization use ISOMIP_initialization, only : ISOMIP_initialize_topography use benchmark_initialization, only : benchmark_initialize_topography use Neverland_initialization, only : Neverland_initialize_topography +use shoebox_initialization, only : shoebox_initialize_topography +use channel_initialization, only : channel_initialize_topography +use channels_initialization, only : channels_initialize_topography +use channelssp_initialization, only : channelssp_initialize_topography +use channel3_initialization, only : channel3_initialize_topography +use box_initialization, only : box_initialize_topography +use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography use Kelvin_initialization, only : Kelvin_initialize_topography use sloshing_initialization, only : sloshing_initialize_topography @@ -193,6 +200,13 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t\t profile in the meridional direction. \n"//& " \t benchmark - use the benchmark test case topography. \n"//& " \t Neverland - use the Neverland test case topography. \n"//& + " \t shoebox - use the shoebox test case topography. \n"//& + " \t channel - use the channel test case topography. \n"//& + " \t channels - use the channels test case topography. \n"//& + " \t channelssp - use the channelssp test case topography. \n"//& + " \t channel3 - use the channel3 test case topography. \n"//& + " \t box - use the box test case topography. \n"//& + " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& " \t\t DOME sill-overflow test case. \n"//& " \t ISOMIP - use a slope and channel configuration for the \n"//& @@ -218,6 +232,13 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("ISOMIP"); call ISOMIP_initialize_topography(D, G, PF, max_depth) case ("benchmark"); call benchmark_initialize_topography(D, G, PF, max_depth) case ("Neverland"); call Neverland_initialize_topography(D, G, PF, max_depth) + case ("shoebox"); call shoebox_initialize_topography(D, G, PF, max_depth) + case ("channel"); call channel_initialize_topography(D, G, PF, max_depth) + case ("channels"); call channels_initialize_topography(D, G, PF, max_depth) + case ("channelssp"); call channelssp_initialize_topography(D, G, PF, max_depth) + case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) + case ("box"); call box_initialize_topography(D, G, PF, max_depth) + case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) case ("Kelvin"); call Kelvin_initialize_topography(D, G, PF, max_depth) case ("sloshing"); call sloshing_initialize_topography(D, G, PF, max_depth) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 56e49a3fc9..7c9d3d3c7c 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -55,6 +55,9 @@ module MOM_state_initialization use benchmark_initialization, only : benchmark_initialize_thickness use benchmark_initialization, only : benchmark_init_temperature_salinity use Neverland_initialization, only : Neverland_initialize_thickness +use shoebox_initialization, only : shoebox_initialize_thickness +use channel_initialization, only : channel_initialize_thickness +use channel_initialization, only: channel_initialiate_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -246,6 +249,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t\t ISOMIP test case. \n"//& " \t benchmark - use the benchmark test case thicknesses. \n"//& " \t Neverland - use the Neverland test case thicknesses. \n"//& + " \t shoebox - use the shoebox test case thicknesses. \n"//& + " \t channel - use the channel test case thicknesses. \n"//& " \t search - search a density profile for the interface \n"//& " \t\t densities. This is not yet implemented. \n"//& " \t circle_obcs - the circle_obcs test case is used. \n"//& @@ -279,6 +284,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) case ("Neverland"); call Neverland_initialize_thickness(h, G, GV, PF, & tv%eqn_of_state, tv%P_Ref) + case ("shoebox"); call shoebox_initialize_thickness(h, G, GV, PF, & + tv%eqn_of_state, tv%P_Ref) + case ("channel"); call channel_initialize_thickness(h, G, GV, PF, & + tv%eqn_of_state, tv%P_Ref) case ("search"); call initialize_thickness_search case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & just_read_params=just_read) @@ -504,6 +513,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \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"//& + " \t channel - Sponge at the northern boundary of the domain\n"//& " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") select case (trim(config)) @@ -516,6 +526,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & PF, sponge_CSp, h) + case ("channel"); call channel_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & diff --git a/src/user/bowlhk_initialization.F90 b/src/user/bowlhk_initialization.F90 new file mode 100644 index 0000000000..6746134ef8 --- /dev/null +++ b/src/user/bowlhk_initialization.F90 @@ -0,0 +1,105 @@ +module bowlhk_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public bowlhk_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up hk's bowl test case topography. +subroutine bowlhk_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, ll=5.0 ! the width of continental slope, in degree + real :: lx, ly, dx ! non-dimensional longitudinal grid scale + character(len=40) :: mod = "bowlhk_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + latext = G%len_lat; lonext = G%len_lon + lx = ll/lonext; ly = ll/latext ! non-dimensional continental shelf width + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext ! non-dimensional zonal grid increment + + call MOM_mesg(" bowlhk_initialization.F90, bowlhk_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! this sets up a bowl shaped topography, with sloping continental shelf in all 4 sides + ! named bowlhk to dinstinguish from the bowl topo inherint in MOM6 by GFDL + + if (x<=lx .and. y<=ly) then + D(i,j) = max(-1.0+cos(x/lx*PI/2), -1.0+cos(y/ly*PI/2)) + elseif (x<=lx .and. y>=1-ly) then + D(i,j) = max(-1.0+cos(x/lx*PI/2), -1.0+cos((y-1)/ly*PI/2)) + elseif (x>=1-lx .and. y<=ly) then + D(i,j) = max(-1.0+cos((x-1)/lx*PI/2), -1.0+cos(y/ly*PI/2)) + elseif (x>=1-lx .and. y>=1-ly) then + D(i,j) = max(-1.0+cos((x-1)/lx*PI/2), -1.0+cos((y-1)/ly*PI/2)) + elseif (x<=lx) then + D(i,j) = -1.0+cos(x/lx*PI/2) + elseif (x>=1-lx) then + D(i,j) = -1.0+cos((x-1)/lx*PI/2) + elseif (y<=ly) then + D(i,j) = -1.0+cos(y/ly*PI/2) + elseif (y>=1-ly) then + D(i,j) = -1.0+cos((y-1)/ly*PI/2) + else + D(i,j) = -1.0 + endif + + if (D(i,j) < -1.0) then + D(i,j) = -1.0 + else if (D(i,j) > 0.0) then + D(i,j) = 0.0 + endif + + ! make sure the region is zonally blocked + if (x<=dx/1.5) then + D(i,j) = 0.0 + elseif (x>=1-dx/1.5) then + D(i,j) = 0.0 + endif + + D(i,j) = -D(i,j) * max_depth + enddo + enddo + +end subroutine bowlhk_initialize_topography + + +end module bowlhk_initialization diff --git a/src/user/box_initialization.F90 b/src/user/box_initialization.F90 new file mode 100644 index 0000000000..6dba109ec4 --- /dev/null +++ b/src/user/box_initialization.F90 @@ -0,0 +1,72 @@ +module box_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public box_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the box test case topography. +subroutine box_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + +! This subroutine sets up the box test case topography + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: x, dx ! non-dimensional longitudinal grid scale + + character(len=40) :: mod = "box_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + latext = G%len_lat + lonext = G%len_lon + D = 1.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" box_initialization.F90, box_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + ! meridional walls at western boundary + if (x < dx/1.5) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + +end subroutine box_initialize_topography + + +end module box_initialization diff --git a/src/user/channel3_initialization.F90 b/src/user/channel3_initialization.F90 new file mode 100644 index 0000000000..34dd8567ea --- /dev/null +++ b/src/user/channel3_initialization.F90 @@ -0,0 +1,195 @@ +module channel3_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel3_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel3 test case topography. +!> channel3 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the northern sponge region was left with no slope so that the sponge layer can be correctly adopted +!> 3) the continental slope on west and east boundaries decay to zero at the edge of sponge + +subroutine channel3_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel3_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel3_initialization.F90, channel3_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y = (G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! This sets topography that has a reentrant channel between southern and northern boundaries + ! difference from channls: no slope in the northern boundary, to allow the sponge to work properly + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& + *spike(max(0.0, y-(1.0-ssp)+sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& + *spike(max(0.0, y-(1.0-ssp)+sdp/2.0), sdp) & ! Patagonia, east + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east + -spike(y, ll/latext) & ! Antarctica + - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=ll/2/lonext .and. x<=1.0-ll/2/lonext .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if ((y>=reentrantn+sdp .and. x<=dx/1.5) .or. (y>=reentrantn+sdp .and. x>=1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel3_initialize_topography + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel3_initialization diff --git a/src/user/channel_initialization.F90 b/src/user/channel_initialization.F90 new file mode 100644 index 0000000000..b6cc32601b --- /dev/null +++ b/src/user/channel_initialization.F90 @@ -0,0 +1,322 @@ +module channel_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel_initialize_topography +public channel_initialize_thickness +public channel_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel test case topography. +subroutine channel_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + +! This subroutine sets up the channel test case topography + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + + character(len=40) :: mod = "channel_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel_initialization.F90, channel_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! This sets topography that has a reentrant channel between southern and northern boundaries + D(i,j) = 1.0 - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.)& !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top + if (D(i,j) < 1 - sa) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! meridional walls outside of the reentrant channel, in the west boundary + if (x= reentrantn) then ! the wall north of Drake Passage + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel_initialize_topography + +! ----------------------------------------------------------------------------- +!> This subroutine initializes layer thicknesses for the channel test case, +!! by finding the depths of interfaces in a specified latitude-dependent +!! temperature profile with an exponentially decaying thermocline on top of a +!! linear stratification. +subroutine channel_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ref) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being + !! initialized. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open + !! file to parse for model + !! parameter values. + type(EOS_type), pointer :: eqn_of_state !< integer that selects the + !! equation of state. + real, intent(in) :: P_Ref !< The coordinate-density + !! reference pressure in Pa. + ! Local variables + real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) + real :: e_interface ! Current interface positoin (m) + character(len=40) :: mod = "channel_initialize_thickness" ! This subroutine's name. + integer :: i, j, k, k1, is, ie, js, je, nz, itt + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + call MOM_mesg(" channel_initialization.F90, channel_initialize_thickness: setting thickness", 5) + call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & + "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) + +! e0 is the notional position of interfaces + e0(1) = 0. ! The surface + do k=1,nz + e0(k+1) = e0(k) - h_profile(k) + enddo + + do j=js,je ; do i=is,ie + e_interface = -G%bathyT(i,j) + do k=nz,1,-1 + h(i,j,k) = max( GV%Angstrom_z, e0(k) - e_interface ) + e_interface = max( e0(k), e_interface - h(i,j,k) ) + enddo + + enddo ; enddo + +end subroutine channel_initialize_thickness + +! ----------------------------------------------------------------------------- +!> 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 channel_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real, dimension(SZK_(G)) :: rho ! layer densities + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real :: eta0(SZK_(G)+1) ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, etab, c = 7.7, rhot, rhob, min_depth, intrho, nlat, ll, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! etab: bottom ocean height; rhot & rhob: biggest/smallest rho in the sponge layer; + ! c: constant in fitting eta = eta(rho); intrho is interface rho; + ! ll is the double width of continental slope, dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; etab = - G%max_depth; + ll = 3.0/G%len_lon ! non-dimensional longitudinal range where continental slope is located + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + rho = GV%Rlay ! loaded target potential density for each layer + rhot = 1025.212 ! target surface rho in the sponge + rhob = 1027.412 ! target bottom interface rho in the sponge + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + ! compute target interface heights, stored in eta0 + do k = 4, nz-2 ! top 3 interface heights = 0.0, so start from k = 4 + intrho = (rho(k-1)+rho(k))/2.0 ! interface rho + eta0(k) = etab*(1-1/c*log(1-(exp(c)-1)*(intrho-rhob)/(rhob-rhot))) ! target height at each interface + enddo + do k = nz-1, nz+1 + eta0(k) = etab ! interface heights reaches ocean bottom + enddo + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if ((G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)>=ll+dx/2) .or. & + (G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)<=1.0-ll-dx/2)) then ! the sponge has meridional AND zonal range + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel_initialize_sponges + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel_initialization diff --git a/src/user/channels_initialization.F90 b/src/user/channels_initialization.F90 new file mode 100644 index 0000000000..d1c2c9f1ca --- /dev/null +++ b/src/user/channels_initialization.F90 @@ -0,0 +1,183 @@ +module channels_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channels_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channels test case topography. +!> difference from channel: whereever it has vertical walls in channel setup, +!> it will be replaced by continental slopes, including in the sponge layer + +subroutine channels_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channels + real :: sdp = 4.0, ll=6.0 ! the width of the slope in Drake Passage, and the half width of continental slope + + character(len=40) :: mod = "channels_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channels_initialization.F90, channels_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east + -spike(y, ll/latext) & ! Antarctica + -spike(y-1.0, ll/latext) & ! northern boundary + - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top + if (D(i,j)<1.0 - sa .and. x>=ll/2/lonext .and. x<=1.0-ll/2/lonext .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then ! make sure nowhere is deeper than sa + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channels_initialize_topography + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channels_initialization diff --git a/src/user/channelssp_initialization.F90 b/src/user/channelssp_initialization.F90 new file mode 100644 index 0000000000..46ec0faf97 --- /dev/null +++ b/src/user/channelssp_initialization.F90 @@ -0,0 +1,184 @@ +module channelssp_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channelssp_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channelssp test case topography. +!> This sets topography that has a reentrant channel between southern and +!> northern boundaries +!> difference from channls: no slope in the northern boundary, to allow the +!> sponge to work properly + +subroutine channelssp_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 4.0, ll=6.0 ! the width of the slope in Drake Passage, and the half width of continental slope + + character(len=40) :: mod = "channelssp_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext ! longitudinal increment for each grid; non-dimensional + + call MOM_mesg(" channelssp_initialization.F90, channelssp_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east + -spike(y, ll/latext) & ! Antarctica + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channelssp_initialize_topography + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channelssp_initialization diff --git a/src/user/shoebox_initialization.F90 b/src/user/shoebox_initialization.F90 new file mode 100644 index 0000000000..0e23599fa2 --- /dev/null +++ b/src/user/shoebox_initialization.F90 @@ -0,0 +1,217 @@ +module shoebox_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +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_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public shoebox_initialize_topography +public shoebox_initialize_thickness + +contains + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the shoebox test case topography. +subroutine shoebox_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + +! This subroutine sets up the shoebox test case topography + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mod = "shoebox_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + D = 0.0 + dx = (G%geoLonT(is+1,js) - G%geoLonT(is, js)) / lonext + + call MOM_mesg(" shoebox_initialization.F90, shoebox_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! This sets topography that has a reentrant channel to the south and a basin in the north + + D(i,j) = 1.0 - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.)& !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top + if (D(i,j) < 1 - sa) then + D(i,j) = 1 - sa + elseif (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! meridional walls outside of the reentrant channel, in the west boundary + if (x <= dx .and. y <= reentrants) then ! the wall south of Drake Passage + D(i,j) = 0.0 + elseif (x <= dx .and. y >= reentrantn) then ! the wall north of Drake Passage + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine shoebox_initialize_topography + +! ----------------------------------------------------------------------------- +!> This subroutine initializes layer thicknesses for the shoebox test case, +!! by finding the depths of interfaces in a specified latitude-dependent +!! temperature profile with an exponentially decaying thermocline on top of a +!! linear stratification. +subroutine shoebox_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ref) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being + !! initialized. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open + !! file to parse for model + !! parameter values. + type(EOS_type), pointer :: eqn_of_state !< integer that selects the + !! equation of state. + real, intent(in) :: P_Ref !< The coordinate-density + !! reference pressure in Pa. + ! Local variables + real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real, dimension(SZK_(G)) :: h_profile ! Vector of initial thickness profile (m) + real :: e_interface ! Current interface positoin (m) + character(len=40) :: mod = "shoebox_initialize_thickness" ! This subroutine's name. + integer :: i, j, k, k1, is, ie, js, je, nz, itt + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + + call MOM_mesg(" shoebox_initialization.F90, shoebox_initialize_thickness: setting thickness", 5) + call get_param(param_file, mod, "INIT_THICKNESS_PROFILE", h_profile, & + "Profile of initial layer thicknesses.", units="m", fail_if_missing=.true.) + +! e0 is the notional position of interfaces + e0(1) = 0. ! The surface + do k=1,nz + e0(k+1) = e0(k) - h_profile(k) + enddo + + do j=js,je ; do i=is,ie + e_interface = -G%bathyT(i,j) + do k=nz,1,-1 + h(i,j,k) = max( GV%Angstrom_z, e0(k) - e_interface ) + e_interface = max( e0(k), e_interface - h(i,j,k) ) + enddo + + enddo ; enddo + +end subroutine shoebox_initialize_thickness + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module shoebox_initialization From 10c0de3656581e472373d6afc9b6fe93fc5d0551 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sun, 10 Dec 2017 12:24:02 -0600 Subject: [PATCH 02/26] modified: src/initialization/MOM_state_initialization.F90 --- src/initialization/MOM_state_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7c9d3d3c7c..18f2c2e528 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -57,7 +57,7 @@ module MOM_state_initialization use Neverland_initialization, only : Neverland_initialize_thickness use shoebox_initialization, only : shoebox_initialize_thickness use channel_initialization, only : channel_initialize_thickness -use channel_initialization, only: channel_initialiate_sponges +use channel_initialization, only: channel_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness From 291e7d32d0894daef2944db1c139c67367dc7bd4 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sun, 10 Dec 2017 17:03:21 -0600 Subject: [PATCH 03/26] modified: src/initialization/MOM_state_initialization.F90 modified: src/user/channel_initialization.F90 modified: src/user/channelssp_initialization.F90 --- .../MOM_state_initialization.F90 | 3 + src/user/channel_initialization.F90 | 10 +- src/user/channelssp_initialization.F90 | 111 ++++++++++++++++++ 3 files changed, 118 insertions(+), 6 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 18f2c2e528..7514ec8d6f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -58,6 +58,7 @@ module MOM_state_initialization use shoebox_initialization, only : shoebox_initialize_thickness use channel_initialization, only : channel_initialize_thickness use channel_initialization, only: channel_initialize_sponges +use channelssp_initialization, only: channelssp_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -528,6 +529,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & PF, sponge_CSp, h) case ("channel"); call channel_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channelssp"); call channelssp_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & diff --git a/src/user/channel_initialization.F90 b/src/user/channel_initialization.F90 index b6cc32601b..e17c31b6cb 100644 --- a/src/user/channel_initialization.F90 +++ b/src/user/channel_initialization.F90 @@ -102,10 +102,9 @@ subroutine channel_initialize_topography(D, G, param_file, max_depth) end subroutine channel_initialize_topography ! ----------------------------------------------------------------------------- -!> This subroutine initializes layer thicknesses for the channel test case, -!! by finding the depths of interfaces in a specified latitude-dependent -!! temperature profile with an exponentially decaying thermocline on top of a -!! linear stratification. +!> sets up the sponge layer in the northernmost degrees of topography +!> from westmost longitude to the eastmost longitude + subroutine channel_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ref) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -219,8 +218,7 @@ subroutine channel_initialize_sponges(G, GV, use_temperature, tv, param_file, CS ! initialize the damping rate so it is 0 outside of the sponge layer & ! and increases linearly with latitude within the sponge layer do i = is, ie; do j = js, je - if ((G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)>=ll+dx/2) .or. & - (G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)<=1.0-ll-dx/2)) then ! the sponge has meridional AND zonal range + if (G%geoLatT(i,j) >= nlat-spongelen) then damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) else damp = 0.0 ! outside of the sponge diff --git a/src/user/channelssp_initialization.F90 b/src/user/channelssp_initialization.F90 index 46ec0faf97..604deb3367 100644 --- a/src/user/channelssp_initialization.F90 +++ b/src/user/channelssp_initialization.F90 @@ -18,6 +18,7 @@ module channelssp_initialization #include public channelssp_initialize_topography +public channelssp_initialize_sponges ! This include declares and sets the variable "version". #include "version_variable.h" @@ -102,6 +103,116 @@ subroutine channelssp_initialize_topography(D, G, param_file, max_depth) end subroutine channelssp_initialize_topography +! ----------------------------------------------------------------------------- +!> set up the sponge used for channelssp topography +!> difference from the sponge designed in channel_initialization.F90: +!> no sponge to restore interface heights where there is continental slope +!> specific for channelssp: the northermost several degrees of west/east boundaries + +subroutine channelssp_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of + ! set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real, dimension(SZK_(G)) :: rho ! layer densities + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only + ! within the sponge layer + real :: eta0(SZK_(G)+1) ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, etab, c = 7.7, rhot, rhob, min_depth, intrho, nlat, ll, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! etab: bottom ocean height; rhot & rhob: biggest/smallest rho in the sponge + ! layer; + ! c: constant in fitting eta = eta(rho); intrho is interface rho; + ! ll is the double width of continental slope, dx is non-dimensional + ! longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channelssp_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; etab = - G%max_depth; + ll = 3.0/G%len_lon ! non-dimensional longitudinal range where continental slope is located + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + rho = GV%Rlay ! loaded target potential density for each layer + rhot = 1025.212 ! target surface rho in the sponge + rhob = 1027.412 ! target bottom interface rho in the sponge + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + ! compute target interface heights, stored in eta0 + do k = 4, nz-2 ! top 3 interface heights = 0.0, so start from k = 4 + intrho = (rho(k-1)+rho(k))/2.0 ! interface rho + eta0(k) = etab*(1-1/c*log(1-(exp(c)-1)*(intrho-rhob)/(rhob-rhot))) ! target height at each interface + enddo + do k = nz-1, nz+1 + eta0(k) = etab ! interface heights reaches ocean bottom + enddo + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if ((G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)>=ll+dx/2) .or. & + (G%geoLatT(i,j) >= nlat-spongelen .and. G%geoLonT(i,j)<=1.0-ll-dx/2)) then ! the sponge has meridional AND zonal range + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channelssp_initialize_sponges + + + ! ----------------------------------------------------------------------------- ! define functions used in the above subroutines From 71840a807d8594a4d197ebd25105b3b8888ac8af Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sun, 10 Dec 2017 17:58:36 -0600 Subject: [PATCH 04/26] modified: src/user/channel3_initialization.F90 --- src/user/channel3_initialization.F90 | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/src/user/channel3_initialization.F90 b/src/user/channel3_initialization.F90 index 34dd8567ea..c41ada4077 100644 --- a/src/user/channel3_initialization.F90 +++ b/src/user/channel3_initialization.F90 @@ -29,8 +29,8 @@ module channel3_initialization !> This subroutine sets up the channel3 test case topography. !> channel3 is similar to channel but: !> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability -!> 2) the northern sponge region was left with no slope so that the sponge layer can be correctly adopted -!> 3) the continental slope on west and east boundaries decay to zero at the edge of sponge +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay to zero at the edge of sponge subroutine channel3_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type @@ -63,7 +63,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) ssp = ssp/latext D = 0.0 dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext - + call MOM_mesg(" channel3_initialization.F90, channel3_initialize_topography: setting topography", 5) call log_version(param_file, mod, version, "") @@ -73,13 +73,12 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) do j = js,je ! meridional grid points do i = is,ie ! zonal grid points x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude - y = (G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude ! This sets topography that has a reentrant channel between southern and northern boundaries ! difference from channls: no slope in the northern boundary, to allow the sponge to work properly D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& - *spike(max(0.0, y-(1.0-ssp)+sdp/2.0), sdp) & ! Patagonia, west + *spike(max(0.0, y-(1.0-ssp-sdp/2.0)), sdp) & ! Patagonia, west -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& *spike(max(0.0, y-(1.0-ssp)+sdp/2.0), sdp) & ! Patagonia, east -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west @@ -101,7 +100,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) endif ! make sure the model is not zonally reentrant outside of Drake Passage - if ((y>=reentrantn+sdp .and. x<=dx/1.5) .or. (y>=reentrantn+sdp .and. x>=1.0-dx/1.5)) then + if ((y>=reentrantn+sdp .and. x=reentrantn+sdp .and. x>1.0-dx/1.5)) then D(i,j) = 0.0 endif From 84b5dbd53e25efc267d43c4bb8bf449c7b86d00e Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Mon, 11 Dec 2017 20:37:01 -0600 Subject: [PATCH 05/26] modified: src/user/channel3_initialization.F90 modified: src/user/channelssp_initialization.F90 --- src/user/channel3_initialization.F90 | 6 ++++-- src/user/channelssp_initialization.F90 | 2 +- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/src/user/channel3_initialization.F90 b/src/user/channel3_initialization.F90 index c41ada4077..9c84886d22 100644 --- a/src/user/channel3_initialization.F90 +++ b/src/user/channel3_initialization.F90 @@ -63,6 +63,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) ssp = ssp/latext D = 0.0 dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + print *, 'dx=', dx*lonext call MOM_mesg(" channel3_initialization.F90, channel3_initialize_topography: setting topography", 5) @@ -73,6 +74,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) do j = js,je ! meridional grid points do i = is,ie ! zonal grid points x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude ! This sets topography that has a reentrant channel between southern and northern boundaries ! difference from channls: no slope in the northern boundary, to allow the sponge to work properly @@ -80,7 +82,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& *spike(max(0.0, y-(1.0-ssp-sdp/2.0)), sdp) & ! Patagonia, west -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp)& - *spike(max(0.0, y-(1.0-ssp)+sdp/2.0), sdp) & ! Patagonia, east + *spike(max(0.0, y-(1.0-ssp-sdp/2.0)), sdp) & ! Patagonia, east -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east -spike(y, ll/latext) & ! Antarctica @@ -93,7 +95,7 @@ subroutine channel3_initialize_topography(D, G, param_file, max_depth) - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior - if (D(i,j)<1.0 - sa .and. x>=ll/2/lonext .and. x<=1.0-ll/2/lonext .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then D(i,j) = 1 - sa else if (D(i,j) > 1.0) then D(i,j) = 1.0 diff --git a/src/user/channelssp_initialization.F90 b/src/user/channelssp_initialization.F90 index 604deb3367..ca01b3dd4b 100644 --- a/src/user/channelssp_initialization.F90 +++ b/src/user/channelssp_initialization.F90 @@ -89,7 +89,7 @@ subroutine channelssp_initialize_topography(D, G, param_file, max_depth) - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior - if (D(i,j)<1.0 - sa .and. x>=dx+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then D(i,j) = 1 - sa else if (D(i,j) > 1.0) then D(i,j) = 1.0 From 329f64882e98eb977bbd53123709ac0637b44520 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 12 Dec 2017 09:57:50 -0600 Subject: [PATCH 06/26] modified: src/user/channel_initialization.F90 --- src/user/channel_initialization.F90 | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/user/channel_initialization.F90 b/src/user/channel_initialization.F90 index e17c31b6cb..36876768ec 100644 --- a/src/user/channel_initialization.F90 +++ b/src/user/channel_initialization.F90 @@ -83,8 +83,10 @@ subroutine channel_initialize_topography(D, G, param_file, max_depth) ! make sure no deeper than max depth and no shallower than Scotia Arc top if (D(i,j) < 1 - sa) then D(i,j) = 1 - sa - else if (D(i,j) > 1.0) then + elseif (D(i,j) > 1.0) then D(i,j) = 1.0 + elseif (D(i,j)<0.0) then + D(i,j) = 0.0 endif ! meridional walls outside of the reentrant channel, in the west boundary @@ -93,7 +95,7 @@ subroutine channel_initialize_topography(D, G, param_file, max_depth) elseif (x= reentrantn) then ! the wall north of Drake Passage D(i,j) = 0.0 endif - + D(i,j) = D(i,j) * max_depth enddo enddo From 296c8c47e5af3e3a19356e58cb23441927472f88 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Wed, 13 Dec 2017 21:46:26 -0600 Subject: [PATCH 07/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/channel2_surface_forcing.F90 modified: config_src/solo_driver/channel_surface_forcing.F90 modified: config_src/solo_driver/shoebox_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 modified: src/initialization/MOM_state_initialization.F90 new file: src/user/channel2_initialization.F90 modified: src/user/channel3_initialization.F90 modified: src/user/channel_initialization.F90 modified: src/user/channels_initialization.F90 modified: src/user/channelssp_initialization.F90 modified: src/user/shoebox_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/channel2_surface_forcing.F90 | 269 ++++++++++++++++ .../solo_driver/channel_surface_forcing.F90 | 2 +- .../solo_driver/shoebox_surface_forcing.F90 | 2 +- .../MOM_fixed_initialization.F90 | 3 + .../MOM_state_initialization.F90 | 5 + src/user/channel2_initialization.F90 | 289 ++++++++++++++++++ src/user/channel3_initialization.F90 | 2 +- src/user/channel_initialization.F90 | 2 +- src/user/channels_initialization.F90 | 2 +- src/user/channelssp_initialization.F90 | 2 +- src/user/shoebox_initialization.F90 | 2 +- 12 files changed, 582 insertions(+), 7 deletions(-) create mode 100644 config_src/solo_driver/channel2_surface_forcing.F90 create mode 100644 src/user/channel2_initialization.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 099c4508d8..10f38b7941 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -83,6 +83,8 @@ module MOM_surface_forcing use shoebox_surface_forcing, only : shoebox_surface_forcing_init, shoebox_surface_forcing_CS use channel_surface_forcing, only : channel_wind_forcing, channel_buoyancy_forcing use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS +use channel2_surface_forcing, only : channel2_wind_forcing, channel2_buoyancy_forcing +use channel2_surface_forcing, only : channel2_surface_forcing_init, channel2_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -210,6 +212,7 @@ module MOM_surface_forcing type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL() type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() + type(channel2_surface_forcing_CS), pointer :: channel2_forcing_CSp => NULL() type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() @@ -300,6 +303,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) + elseif (trim(CS%wind_config) == "channel2") then + call channel2_wind_forcing(sfc_state, forces, day_center, G, CS%channel2_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then @@ -336,6 +341,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox_forcing_CSp) elseif (trim(CS%buoy_config) == "channel") then call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel2") then + call channel2_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel2_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then @@ -1823,6 +1830,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call shoebox_surface_forcing_init(Time, G, param_file, diag, CS%shoebox_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) + elseif (trim(CS%wind_config) == "channel2") then + call channel2_surface_forcing_init(Time, G, param_file, diag, CS%channel2_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then diff --git a/config_src/solo_driver/channel2_surface_forcing.F90 b/config_src/solo_driver/channel2_surface_forcing.F90 new file mode 100644 index 0000000000..a45c4e528e --- /dev/null +++ b/config_src/solo_driver/channel2_surface_forcing.F90 @@ -0,0 +1,269 @@ +!> Wind and buoyancy forcing for the channel2 configurations +module channel2_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel2_wind_forcing +public channel2_buoyancy_forcing +public channel2_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel2 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel2_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel2_buoyancy_forcing has been called +end type channel2_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel2 forcing configuration. +subroutine channel2_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel2_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel2_wind_forcing + + +!> Surface fluxes of buoyancy for the channel2 configurations. +subroutine channel2_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel2_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.347, rhon = 1034.152 ! sothern and northern boundary densities of the channel2 + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel2_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel2_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel2_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel2 control structure. +subroutine channel2_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel2_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel2_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel2_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel2_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel2_surface_forcing diff --git a/config_src/solo_driver/channel_surface_forcing.F90 b/config_src/solo_driver/channel_surface_forcing.F90 index f13fcf7fcc..56c232633f 100644 --- a/config_src/solo_driver/channel_surface_forcing.F90 +++ b/config_src/solo_driver/channel_surface_forcing.F90 @@ -259,7 +259,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh diff --git a/config_src/solo_driver/shoebox_surface_forcing.F90 b/config_src/solo_driver/shoebox_surface_forcing.F90 index 9feeb13a8c..0099f30c13 100644 --- a/config_src/solo_driver/shoebox_surface_forcing.F90 +++ b/config_src/solo_driver/shoebox_surface_forcing.F90 @@ -277,7 +277,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index b104fc928c..fcbd567348 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -35,6 +35,7 @@ module MOM_fixed_initialization use channel_initialization, only : channel_initialize_topography use channels_initialization, only : channels_initialize_topography use channelssp_initialization, only : channelssp_initialize_topography +use channel2_initialization, only : channel2_initialize_topography use channel3_initialization, only : channel3_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography @@ -204,6 +205,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t channel - use the channel test case topography. \n"//& " \t channels - use the channels test case topography. \n"//& " \t channelssp - use the channelssp test case topography. \n"//& + " \t channel2 - use the channel2 test case topography. \n"//& " \t channel3 - use the channel3 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& @@ -236,6 +238,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("channel"); call channel_initialize_topography(D, G, PF, max_depth) case ("channels"); call channels_initialize_topography(D, G, PF, max_depth) case ("channelssp"); call channelssp_initialize_topography(D, G, PF, max_depth) + case ("channel2"); call channel2_initialize_topography(D, G, PF, max_depth) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 7514ec8d6f..e42ab4affb 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -59,6 +59,7 @@ module MOM_state_initialization use channel_initialization, only : channel_initialize_thickness use channel_initialization, only: channel_initialize_sponges use channelssp_initialization, only: channelssp_initialize_sponges +use channel2_initialization, only: channel2_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -515,6 +516,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t\t DOME sill-overflow test case. \n"//& " \t BFB - Sponge at the southern boundary of the domain\n"//& " \t channel - Sponge at the northern boundary of the domain\n"//& + " \t channel2 - Sponge at the northern boundary of the domain\n"//& + " \t channelssp - Sponge at the northern boundary of the domain but avoid e/w boundaries\n"//& " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") select case (trim(config)) @@ -531,6 +534,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channelssp"); call channelssp_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel2"); call channel2_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & diff --git a/src/user/channel2_initialization.F90 b/src/user/channel2_initialization.F90 new file mode 100644 index 0000000000..76b420888e --- /dev/null +++ b/src/user/channel2_initialization.F90 @@ -0,0 +1,289 @@ +module channel2_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel2_initialize_topography +public channel2_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel2 test case topography. +!> channel2 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge + +subroutine channel2_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel2_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel2_initialization.F90, channel2_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patanogina, east + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east + -spike(y, ll/latext) & ! Antarctica + - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! no continental slope in the sponge layer + if (y >= 1.0-ssp) then + D(i,j)=1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if ((y>=reentrantn+sdp .and. x=reentrantn+sdp .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel2_initialize_topography + + + +! ----------------------------------------------------------------------------- +!> 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 channel2_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel2_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + eta0 = (/0.0,0.0,0.0,-49.0,-99.0,-152.0,-211.0,-281.0,-361.0,-450.0, & + -550.0,-659.0,-779.0,-908.0,-1047.0,-1197.0,-1357.0, & + -1527.0,-1707.0,-1898.0,-2095.0,-2306.0,-2529.0,-2760.0, & + -2998.0,-3244.0,-3492.0,-3750.0,-4000.0,-4000.0,-4000.0 /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel2_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel2_initialization diff --git a/src/user/channel3_initialization.F90 b/src/user/channel3_initialization.F90 index 9c84886d22..b52209e801 100644 --- a/src/user/channel3_initialization.F90 +++ b/src/user/channel3_initialization.F90 @@ -156,7 +156,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell diff --git a/src/user/channel_initialization.F90 b/src/user/channel_initialization.F90 index 36876768ec..0431cba7c3 100644 --- a/src/user/channel_initialization.F90 +++ b/src/user/channel_initialization.F90 @@ -282,7 +282,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell diff --git a/src/user/channels_initialization.F90 b/src/user/channels_initialization.F90 index d1c2c9f1ca..0cb0e25529 100644 --- a/src/user/channels_initialization.F90 +++ b/src/user/channels_initialization.F90 @@ -143,7 +143,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell diff --git a/src/user/channelssp_initialization.F90 b/src/user/channelssp_initialization.F90 index ca01b3dd4b..f873a82d6f 100644 --- a/src/user/channelssp_initialization.F90 +++ b/src/user/channelssp_initialization.F90 @@ -255,7 +255,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell diff --git a/src/user/shoebox_initialization.F90 b/src/user/shoebox_initialization.F90 index 0e23599fa2..555451c822 100644 --- a/src/user/shoebox_initialization.F90 +++ b/src/user/shoebox_initialization.F90 @@ -177,7 +177,7 @@ real function cosbellh(x, L, dir) xx = x endif - cosbellh = cos(PI/2.0*MIN(xx/L, 1.0)) + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh !< similar to cosbellh but takes a different shape of bell From e2a38c3353976c81715d7551a4792b0b5dccc72b Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sat, 23 Dec 2017 19:49:39 -0600 Subject: [PATCH 08/26] modified: config_src/solo_driver/channel2_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 modified: src/initialization/MOM_state_initialization.F90 modified: src/user/channel2_initialization.F90 new file: src/user/channel4_initialization.F90 --- .../solo_driver/channel2_surface_forcing.F90 | 2 +- .../MOM_fixed_initialization.F90 | 3 + .../MOM_state_initialization.F90 | 4 + src/user/channel2_initialization.F90 | 3 +- src/user/channel4_initialization.F90 | 294 ++++++++++++++++++ 5 files changed, 304 insertions(+), 2 deletions(-) create mode 100644 src/user/channel4_initialization.F90 diff --git a/config_src/solo_driver/channel2_surface_forcing.F90 b/config_src/solo_driver/channel2_surface_forcing.F90 index a45c4e528e..664a66b411 100644 --- a/config_src/solo_driver/channel2_surface_forcing.F90 +++ b/config_src/solo_driver/channel2_surface_forcing.F90 @@ -109,7 +109,7 @@ subroutine channel2_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. real :: y, latext ! ND latitude, latitudinal range - real :: den, rhos = 1037.347, rhon = 1034.152 ! sothern and northern boundary densities of the channel2 + real :: den, rhos = 1037.370, rhon = 1034.209 ! sothern and northern boundary densities of the channel2 integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index fcbd567348..c90c90450c 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -37,6 +37,7 @@ module MOM_fixed_initialization use channelssp_initialization, only : channelssp_initialize_topography use channel2_initialization, only : channel2_initialize_topography use channel3_initialization, only : channel3_initialize_topography +use channel4_initialization, only : channel4_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -207,6 +208,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t channelssp - use the channelssp test case topography. \n"//& " \t channel2 - use the channel2 test case topography. \n"//& " \t channel3 - use the channel3 test case topography. \n"//& + " \t channel4 - use the channel4 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& @@ -240,6 +242,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("channelssp"); call channelssp_initialize_topography(D, G, PF, max_depth) case ("channel2"); call channel2_initialize_topography(D, G, PF, max_depth) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) + case ("channel4"); call channel4_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index e42ab4affb..eaa0b8ab07 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -60,6 +60,7 @@ module MOM_state_initialization use channel_initialization, only: channel_initialize_sponges use channelssp_initialization, only: channelssp_initialize_sponges use channel2_initialization, only: channel2_initialize_sponges +use channel4_initialization, only: channel4_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -517,6 +518,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t BFB - Sponge at the southern boundary of the domain\n"//& " \t channel - Sponge at the northern boundary of the domain\n"//& " \t channel2 - Sponge at the northern boundary of the domain\n"//& + " \t channel4 - Sponge at the northern boundary of the domain\n"//& " \t channelssp - Sponge at the northern boundary of the domain but avoid e/w boundaries\n"//& " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") @@ -536,6 +538,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channel2"); call channel2_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel4"); call channel4_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & diff --git a/src/user/channel2_initialization.F90 b/src/user/channel2_initialization.F90 index 76b420888e..9304c69bc6 100644 --- a/src/user/channel2_initialization.F90 +++ b/src/user/channel2_initialization.F90 @@ -102,7 +102,8 @@ subroutine channel2_initialize_topography(D, G, param_file, max_depth) endif ! make sure the model is not zonally reentrant outside of Drake Passage - if ((y>=reentrantn+sdp .and. x=reentrantn+sdp .and. x>1.0-dx/1.5)) then + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then D(i,j) = 0.0 endif diff --git a/src/user/channel4_initialization.F90 b/src/user/channel4_initialization.F90 new file mode 100644 index 0000000000..2ba0f9eef4 --- /dev/null +++ b/src/user/channel4_initialization.F90 @@ -0,0 +1,294 @@ +module channel4_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel4_initialize_topography +public channel4_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel4 test case topography. +!> channel4 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge +!> 4) the shape of Drake Passage in the east is modified so as to match that in the west + +subroutine channel4_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel4_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel4_initialization.F90, channel4_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + -spike(y, ll/latext) & ! Antarctica + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! no continental slope in the sponge layer + if (y >= 1.0-ssp) then + D(i,j)=1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel4_initialize_topography + + + +! ----------------------------------------------------------------------------- +!> 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 channel4_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel4_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 7 + eta0 = (/0.0,0.0,0.0,-49.0,-99.0,-152.0,-211.0,-281.0,-361.0,-450.0, & + -550.0,-659.0,-779.0,-909.0,-1048.0,-1197.0,-1356.0, & + -1527.0,-1706.0,-1896.0,-2095.0,-2311.0,-2529.0,-2753.0, & + -2995.0,-3246.0,-3498.0,-3746.0,-4000.0,-4000.0,-4000.0 /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel4_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel4_initialization From ee828f95eddb31854a35c28f3ecc74d3b3880cf3 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sun, 24 Dec 2017 17:24:36 -0600 Subject: [PATCH 09/26] modified: config_src/solo_driver/shoebox_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 new file: src/user/channel5_initialization.F90 new file: src/user/shoebox2_initialization.F90 new file: src/user/shoebox3_initialization.F90 --- .../solo_driver/shoebox_surface_forcing.F90 | 2 +- .../MOM_fixed_initialization.F90 | 9 + src/user/channel5_initialization.F90 | 199 ++++++++++++++++++ src/user/shoebox2_initialization.F90 | 181 ++++++++++++++++ src/user/shoebox3_initialization.F90 | 179 ++++++++++++++++ 5 files changed, 569 insertions(+), 1 deletion(-) create mode 100644 src/user/channel5_initialization.F90 create mode 100644 src/user/shoebox2_initialization.F90 create mode 100644 src/user/shoebox3_initialization.F90 diff --git a/config_src/solo_driver/shoebox_surface_forcing.F90 b/config_src/solo_driver/shoebox_surface_forcing.F90 index 0099f30c13..da8b0b1b45 100644 --- a/config_src/solo_driver/shoebox_surface_forcing.F90 +++ b/config_src/solo_driver/shoebox_surface_forcing.F90 @@ -114,7 +114,7 @@ subroutine shoebox_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N - real :: den, rho1 = 1027.459, rho2 = 1023.303, rho3 = 1027.093 ! south, equator, north + real :: den, rho1 = 1037.370, rho2 = 1031.500, rho3 = 1036.698 ! south, equator, north integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index c90c90450c..4139665c24 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -32,12 +32,15 @@ module MOM_fixed_initialization use benchmark_initialization, only : benchmark_initialize_topography use Neverland_initialization, only : Neverland_initialize_topography use shoebox_initialization, only : shoebox_initialize_topography +use shoebox2_initialization, only : shoebox2_initialize_topography +use shoebox3_initialization, only : shoebox3_initialize_topography use channel_initialization, only : channel_initialize_topography use channels_initialization, only : channels_initialize_topography use channelssp_initialization, only : channelssp_initialize_topography use channel2_initialization, only : channel2_initialize_topography use channel3_initialization, only : channel3_initialize_topography use channel4_initialization, only : channel4_initialize_topography +use channel5_initialization, only : channel5_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -203,12 +206,15 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t benchmark - use the benchmark test case topography. \n"//& " \t Neverland - use the Neverland test case topography. \n"//& " \t shoebox - use the shoebox test case topography. \n"//& + " \t shoebox2 - use the shoebox2 test case topography. \n"//& + " \t shoebox3 - use the shoebox3 test case topography. \n"//& " \t channel - use the channel test case topography. \n"//& " \t channels - use the channels test case topography. \n"//& " \t channelssp - use the channelssp test case topography. \n"//& " \t channel2 - use the channel2 test case topography. \n"//& " \t channel3 - use the channel3 test case topography. \n"//& " \t channel4 - use the channel4 test case topography. \n"//& + " \t channel5 - use the channel5 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& @@ -237,12 +243,15 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("benchmark"); call benchmark_initialize_topography(D, G, PF, max_depth) case ("Neverland"); call Neverland_initialize_topography(D, G, PF, max_depth) case ("shoebox"); call shoebox_initialize_topography(D, G, PF, max_depth) + case ("shoebox2"); call shoebox2_initialize_topography(D, G, PF, max_depth) + case ("shoebox3"); call shoebox3_initialize_topography(D, G, PF, max_depth) case ("channel"); call channel_initialize_topography(D, G, PF, max_depth) case ("channels"); call channels_initialize_topography(D, G, PF, max_depth) case ("channelssp"); call channelssp_initialize_topography(D, G, PF, max_depth) case ("channel2"); call channel2_initialize_topography(D, G, PF, max_depth) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) case ("channel4"); call channel4_initialize_topography(D, G, PF, max_depth) + case ("channel5"); call channel5_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) diff --git a/src/user/channel5_initialization.F90 b/src/user/channel5_initialization.F90 new file mode 100644 index 0000000000..8d51324be1 --- /dev/null +++ b/src/user/channel5_initialization.F90 @@ -0,0 +1,199 @@ +module channel5_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel5_initialize_topography + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel5 test case topography. +!> channel5 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge +!> 4) the shape of Drake Passage in the east is modified so as to match that in the west +!> 5) remove the slope along Antarctica: to see if only continental slope in west/east boundries work + +subroutine channel5_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel5_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel5_initialization.F90, channel5_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! no continental slope in the sponge layer + if (y >= 1.0-ssp) then + D(i,j)=1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel5_initialize_topography + + +!--------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel5_initialization diff --git a/src/user/shoebox2_initialization.F90 b/src/user/shoebox2_initialization.F90 new file mode 100644 index 0000000000..0c202c0830 --- /dev/null +++ b/src/user/shoebox2_initialization.F90 @@ -0,0 +1,181 @@ +module shoebox2_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +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_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public shoebox2_initialize_topography + +contains + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the shoebox2 test case topography. +!> Differences from shoebox: added continental slopes along all 4 side walls + +subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + +! This subroutine sets up the shoebox2 test case topography + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mod = "shoebox2_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js) - G%geoLonT(is, js)) / lonext + + call MOM_mesg(" shoebox2_initialization.F90, shoebox2_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! This sets topography that has a reentrant channel to the south and a basin in the north + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + -spike(y, ll/latext) & ! Antarctica + -spike(y-1.0, ll/latext) & ! Northern Wall + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 & + .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine shoebox2_initialize_topography + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module shoebox2_initialization diff --git a/src/user/shoebox3_initialization.F90 b/src/user/shoebox3_initialization.F90 new file mode 100644 index 0000000000..38f7ed38ef --- /dev/null +++ b/src/user/shoebox3_initialization.F90 @@ -0,0 +1,179 @@ +module shoebox3_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +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_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public shoebox3_initialize_topography + +contains + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the shoebox3 test case topography. +!> Differences from shoebox: added continental slopes ONLY along east/west boundaries + +subroutine shoebox3_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + +! This subroutine sets up the shoebox3 test case topography + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mod = "shoebox3_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je, isd, ied, jsd, jed + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js) - G%geoLonT(is, js)) / lonext + + call MOM_mesg(" shoebox3_initialization.F90, shoebox3_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + ! Calculate the depth of the bottom. + do j=js,je ! meridional grid points + do i=is,ie ! zonal grid points + x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + ! This sets topography that has a reentrant channel to the south and a basin in the north + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 & + .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine shoebox3_initialize_topography + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module shoebox3_initialization From e176084b1dc12d767f9e9ee5a6a7eb79dd0146c6 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 26 Dec 2017 11:30:24 -0600 Subject: [PATCH 10/26] modified: src/initialization/MOM_fixed_initialization.F90 renamed: src/user/shoebox3_initialization.F90 -> src/user/shoebox0_initialization.F90 modified: src/user/shoebox2_initialization.F90 --- .../MOM_fixed_initialization.F90 | 6 +- ...zation.F90 => shoebox0_initialization.F90} | 84 ++++++------------- src/user/shoebox2_initialization.F90 | 20 +++-- 3 files changed, 45 insertions(+), 65 deletions(-) rename src/user/{shoebox3_initialization.F90 => shoebox0_initialization.F90} (55%) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 4139665c24..0c03623371 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -32,8 +32,8 @@ module MOM_fixed_initialization use benchmark_initialization, only : benchmark_initialize_topography use Neverland_initialization, only : Neverland_initialize_topography use shoebox_initialization, only : shoebox_initialize_topography +use shoebox0_initialization, only : shoebox0_initialize_topography use shoebox2_initialization, only : shoebox2_initialize_topography -use shoebox3_initialization, only : shoebox3_initialize_topography use channel_initialization, only : channel_initialize_topography use channels_initialization, only : channels_initialize_topography use channelssp_initialization, only : channelssp_initialize_topography @@ -206,8 +206,8 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t benchmark - use the benchmark test case topography. \n"//& " \t Neverland - use the Neverland test case topography. \n"//& " \t shoebox - use the shoebox test case topography. \n"//& + " \t shoebox0 - use the shoebox0 test case topography. \n"//& " \t shoebox2 - use the shoebox2 test case topography. \n"//& - " \t shoebox3 - use the shoebox3 test case topography. \n"//& " \t channel - use the channel test case topography. \n"//& " \t channels - use the channels test case topography. \n"//& " \t channelssp - use the channelssp test case topography. \n"//& @@ -243,8 +243,8 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("benchmark"); call benchmark_initialize_topography(D, G, PF, max_depth) case ("Neverland"); call Neverland_initialize_topography(D, G, PF, max_depth) case ("shoebox"); call shoebox_initialize_topography(D, G, PF, max_depth) + case ("shoebox0"); call shoebox0_initialize_topography(D, G, PF, max_depth) case ("shoebox2"); call shoebox2_initialize_topography(D, G, PF, max_depth) - case ("shoebox3"); call shoebox3_initialize_topography(D, G, PF, max_depth) case ("channel"); call channel_initialize_topography(D, G, PF, max_depth) case ("channels"); call channels_initialize_topography(D, G, PF, max_depth) case ("channelssp"); call channelssp_initialize_topography(D, G, PF, max_depth) diff --git a/src/user/shoebox3_initialization.F90 b/src/user/shoebox0_initialization.F90 similarity index 55% rename from src/user/shoebox3_initialization.F90 rename to src/user/shoebox0_initialization.F90 index 38f7ed38ef..70bc61288a 100644 --- a/src/user/shoebox3_initialization.F90 +++ b/src/user/shoebox0_initialization.F90 @@ -1,4 +1,4 @@ -module shoebox3_initialization +module shoebox0_initialization ! This file is part of MOM6. See LICENSE.md for the license. @@ -17,22 +17,22 @@ module shoebox3_initialization #include -public shoebox3_initialize_topography +public shoebox0_initialize_topography contains ! ----------------------------------------------------------------------------- -!> This subroutine sets up the shoebox3 test case topography. -!> Differences from shoebox: added continental slopes ONLY along east/west boundaries +!> This subroutine sets up the shoebox0 test case topography. +!> difference from shoebox: explicitly specify a meridional wall in the east -subroutine shoebox3_initialize_topography(D, G, param_file, max_depth) +subroutine shoebox0_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & intent(out) :: D !< Ocean bottom depth in m type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m -! This subroutine sets up the shoebox3 test case topography +! This subroutine sets up the shoebox0 test case topography real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) real :: latext, lonext ! latitude extent of the model area real :: ep = epsilon(1.) ! an infinitesimally small quantity @@ -42,12 +42,10 @@ subroutine shoebox3_initialize_topography(D, G, param_file, max_depth) real :: dx ! non-dimensional longitudinal grid scale real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern ! boundary of the reentrant channel - real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width - ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "shoebox3_initialize_topography" ! This subroutine's name. + character(len=40) :: mod = "shoebox0_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -57,12 +55,10 @@ subroutine shoebox3_initialize_topography(D, G, param_file, max_depth) lonext = G%len_lon reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone - sdp = sdp/latext - ssp = ssp/latext D = 0.0 dx = (G%geoLonT(is+1,js) - G%geoLonT(is, js)) / lonext - call MOM_mesg(" shoebox3_initialization.F90, shoebox3_initialize_topography: setting topography", 5) + call MOM_mesg(" shoebox0_initialization.F90, shoebox0_initialize_topography: setting topography", 5) call log_version(param_file, mod, version, "") @@ -74,41 +70,34 @@ subroutine shoebox3_initialize_topography(D, G, param_file, max_depth) ! This sets topography that has a reentrant channel to the south and a basin in the north - D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west - -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original - -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope - -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west - -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original - -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope - - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center - - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope - - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope - - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) - - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half - - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) - - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half - - ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior - if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 & - .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1.0 - sa *cosbell(x-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.)& !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top + if (D(i,j) < 1 - sa) then D(i,j) = 1 - sa - else if (D(i,j) > 1.0) then + elseif (D(i,j) > 1.0) then D(i,j) = 1.0 endif - ! make sure the model is not zonally reentrant outside of Drake Passage - if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then - D(i,j) = 0.0 - endif + ! meridional walls outside of the reentrant channel, in the west boundary + if ((x <= dx .or. x >= 1-dx) .and. y <= reentrants) then ! the wall south of Drake Passage + D(i,j) = 0.0 + elseif ((x <= dx .or. x >= 1-dx) .and. y >= reentrantn) then ! the wall north of Drake Passage + D(i,j) = 0.0 + endif D(i,j) = D(i,j) * max_depth enddo enddo -end subroutine shoebox3_initialize_topography - +end subroutine shoebox0_initialize_topography ! ----------------------------------------------------------------------------- ! define functions used in the above subroutines @@ -142,25 +131,6 @@ real function cosbellh(x, L, dir) cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) end function cosbellh - !< similar to cosbellh but takes a different shape of bell - real function cosbellhnew(x, L, dir) - - real, intent(in) :: x !< non-dimensional position - real, intent(in) :: L !< non-dimensional width - real :: PI, xx !< 3.1415926... calculated as 4*atan(1) - real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south - PI = 4.0*atan(1.0) - - !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 - if (x*dir .lt. 0.0) then - xx = L+1 - else - xx = x - endif - - cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) - end function cosbellhnew - !< make sure the depth within L is homogeneous real function homo(x, L) @@ -176,4 +146,4 @@ real function homo(x, L) endif end function homo -end module shoebox3_initialization +end module shoebox0_initialization diff --git a/src/user/shoebox2_initialization.F90 b/src/user/shoebox2_initialization.F90 index 0c202c0830..0943c1b17c 100644 --- a/src/user/shoebox2_initialization.F90 +++ b/src/user/shoebox2_initialization.F90 @@ -72,7 +72,6 @@ subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) x=(G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude - ! This sets topography that has a reentrant channel to the south and a basin in the north D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original @@ -81,13 +80,13 @@ subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope -spike(y, ll/latext) & ! Antarctica - -spike(y-1.0, ll/latext) & ! Northern Wall + -spike(1.0-y, ll/latext) & ! Northern Wall - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope - - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half - - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior @@ -114,6 +113,17 @@ end subroutine shoebox2_initialize_topography ! ----------------------------------------------------------------------------- ! define functions used in the above subroutines +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + !> Returns the value of a cosine-bell function evaluated at x/L real function cosbell(x,L) @@ -160,7 +170,7 @@ real function cosbellhnew(x, L, dir) xx = x endif - cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + cosbellhnew = 0.5*(1+cos(PI*MIN((xx)/L, 1.0))) end function cosbellhnew From 8b064413fcc82cbfdff515444bb47f58a0e2d256 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Sat, 30 Dec 2017 10:42:03 -0600 Subject: [PATCH 11/26] modified: src/user/shoebox0_initialization.F90 modified: src/user/shoebox2_initialization.F90 --- src/user/shoebox0_initialization.F90 | 9 ++++++--- src/user/shoebox2_initialization.F90 | 9 ++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/user/shoebox0_initialization.F90 b/src/user/shoebox0_initialization.F90 index 70bc61288a..dba3fa64c7 100644 --- a/src/user/shoebox0_initialization.F90 +++ b/src/user/shoebox0_initialization.F90 @@ -5,7 +5,7 @@ module shoebox0_initialization use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type, read_param, log_param use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type @@ -42,6 +42,7 @@ subroutine shoebox0_initialize_topography(D, G, param_file, max_depth) real :: dx ! non-dimensional longitudinal grid scale real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern ! boundary of the reentrant channel + real :: min_depth ! This include declares and sets the variable "version". #include "version_variable.h" @@ -50,6 +51,8 @@ subroutine shoebox0_initialize_topography(D, G, param_file, max_depth) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + call read_param(param_file, "MINIMUM_DEPTH", min_depth) ! read in min_depth value + sa = sa_dim / max_depth latext = G%len_lat lonext = G%len_lon @@ -87,9 +90,9 @@ subroutine shoebox0_initialize_topography(D, G, param_file, max_depth) ! meridional walls outside of the reentrant channel, in the west boundary if ((x <= dx .or. x >= 1-dx) .and. y <= reentrants) then ! the wall south of Drake Passage - D(i,j) = 0.0 + D(i,j) = min_depth/max_depth elseif ((x <= dx .or. x >= 1-dx) .and. y >= reentrantn) then ! the wall north of Drake Passage - D(i,j) = 0.0 + D(i,j) = min_depth/max_depth endif D(i,j) = D(i,j) * max_depth diff --git a/src/user/shoebox2_initialization.F90 b/src/user/shoebox2_initialization.F90 index 0943c1b17c..c865d44c85 100644 --- a/src/user/shoebox2_initialization.F90 +++ b/src/user/shoebox2_initialization.F90 @@ -5,7 +5,7 @@ module shoebox2_initialization use MOM_sponge, only : sponge_CS, set_up_sponge_field, initialize_sponge use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type, read_param use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type use MOM_tracer_registry, only : tracer_registry_type @@ -43,7 +43,7 @@ subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern ! boundary of the reentrant channel real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width - + real :: min_depth ! This include declares and sets the variable "version". #include "version_variable.h" @@ -52,6 +52,9 @@ subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + call read_param(param_file, "MINIMUM_DEPTH", min_depth) ! read in min_depth value + + sa = sa_dim / max_depth latext = G%len_lat lonext = G%len_lon @@ -100,7 +103,7 @@ subroutine shoebox2_initialize_topography(D, G, param_file, max_depth) ! make sure the model is not zonally reentrant outside of Drake Passage if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then - D(i,j) = 0.0 + D(i,j) = min_depth/max_depth endif D(i,j) = D(i,j) * max_depth From 237ef6866812b87bc4f7048c97aa2aba7b2a20b3 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 2 Jan 2018 21:24:18 -0600 Subject: [PATCH 12/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 modified: config_src/solo_driver/channel2_surface_forcing.F90 new file: config_src/solo_driver/channel3_surface_forcing.F90 modified: src/user/channel5_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/channel2_surface_forcing.F90 | 3 + .../solo_driver/channel3_surface_forcing.F90 | 246 ++++++++++++++++++ src/user/channel5_initialization.F90 | 12 +- 4 files changed, 266 insertions(+), 4 deletions(-) create mode 100644 config_src/solo_driver/channel3_surface_forcing.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 10f38b7941..5755206772 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -85,6 +85,8 @@ module MOM_surface_forcing use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS use channel2_surface_forcing, only : channel2_wind_forcing, channel2_buoyancy_forcing use channel2_surface_forcing, only : channel2_surface_forcing_init, channel2_surface_forcing_CS +use channel3_surface_forcing, only : channel3_wind_forcing, channel3_buoyancy_forcing +use channel3_surface_forcing, only : channel3_surface_forcing_init, channel3_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -213,6 +215,7 @@ module MOM_surface_forcing type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() type(channel2_surface_forcing_CS), pointer :: channel2_forcing_CSp => NULL() + type(channel3_surface_forcing_CS), pointer :: channel3_forcing_CSp => NULL() type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() @@ -305,6 +308,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then call channel2_wind_forcing(sfc_state, forces, day_center, G, CS%channel2_forcing_CSp) + elseif (trim(CS%wind_config) == "channel3") then + call channel3_wind_forcing(sfc_state, forces, day_center, G, CS%channel3_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then @@ -343,6 +348,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) elseif (trim(CS%buoy_config) == "channel2") then call channel2_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel2_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel3") then + call channel3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel3_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then @@ -1832,6 +1839,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then call channel2_surface_forcing_init(Time, G, param_file, diag, CS%channel2_forcing_CSp) + elseif (trim(CS%wind_config) == "channel3") then + call channel3_surface_forcing_init(Time, G, param_file, diag, CS%channel3_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then diff --git a/config_src/solo_driver/channel2_surface_forcing.F90 b/config_src/solo_driver/channel2_surface_forcing.F90 index 664a66b411..ea460fa988 100644 --- a/config_src/solo_driver/channel2_surface_forcing.F90 +++ b/config_src/solo_driver/channel2_surface_forcing.F90 @@ -1,4 +1,7 @@ !> Wind and buoyancy forcing for the channel2 configurations +!> difference from channel: adjusted surface buoyancy profile so that the +!> sigma_2 value is used, not surface value + module channel2_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/config_src/solo_driver/channel3_surface_forcing.F90 b/config_src/solo_driver/channel3_surface_forcing.F90 new file mode 100644 index 0000000000..742d3bdea9 --- /dev/null +++ b/config_src/solo_driver/channel3_surface_forcing.F90 @@ -0,0 +1,246 @@ +!> Wind and buoyancy forcing for the channel3 configurations +!> difference from channel: adjusted surface buoyancy profile so that the +!> sigma_2 value is used, not surface value + +!> difference from channel2: +!> surface wind is turned off, so as to compare the result from using no +!diapycnal diffusivity but with wind + +module channel3_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel3_wind_forcing +public channel3_buoyancy_forcing +public channel3_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel3 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel3_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel3_buoyancy_forcing has been called +end type channel3_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel3 forcing configuration. +subroutine channel3_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel3_surface_forcing_CS), pointer :: CS !< Control structure for this module. + + ! wind stress is 0 everywhere + forces%taux = 0.0 + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + +end subroutine channel3_wind_forcing + + +!> Surface fluxes of buoyancy for the channel3 configurations. +subroutine channel3_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel3_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.370, rhon = 1034.209 ! sothern and northern boundary densities of the channel3 + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel3_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel3_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel3_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel3 control structure. +subroutine channel3_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel3_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel3_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel3_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel3_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel3_surface_forcing diff --git a/src/user/channel5_initialization.F90 b/src/user/channel5_initialization.F90 index 8d51324be1..58de29d8dc 100644 --- a/src/user/channel5_initialization.F90 +++ b/src/user/channel5_initialization.F90 @@ -2,7 +2,6 @@ module channel5_initialization ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge use MOM_dyn_horgrid, only : dyn_horgrid_type use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe @@ -32,7 +31,9 @@ module channel5_initialization !> 2) the sponge layer has no slope !> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge !> 4) the shape of Drake Passage in the east is modified so as to match that in the west -!> 5) remove the slope along Antarctica: to see if only continental slope in west/east boundries work +!> 5) the only difference from channel 4: Antarctica continental slope reaches +!> the southernmost latitude at surface, i.e. not halfway below sea surface, +!> by introducing a factor of dy (similar to dx) subroutine channel5_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type @@ -47,7 +48,7 @@ subroutine channel5_initialize_topography(D, G, param_file, max_depth) real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc real :: sa ! the non-dimensional height of Scotia Arc top; ! default value is 1500/4000=0.375 - real :: dx ! non-dimensional longitudinal grid scale + real :: dx, dy ! non-dimensional longitudinal/latitudinal grid scale real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern ! boundary of the reentrant channel real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width @@ -65,6 +66,9 @@ subroutine channel5_initialize_topography(D, G, param_file, max_depth) ssp = ssp/latext D = 0.0 dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + dy = (G%geoLatT(is,js+1)-G%geoLatT(is,js))/latext + + print *, 'dy=', dy call MOM_mesg(" channel5_initialization.F90, channel5_initialize_topography: setting topography", 5) @@ -83,6 +87,7 @@ subroutine channel5_initialize_topography(D, G, param_file, max_depth) -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + -spike(y-dy, ll/latext) & ! Antarctica - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope @@ -117,7 +122,6 @@ subroutine channel5_initialize_topography(D, G, param_file, max_depth) end subroutine channel5_initialize_topography -!--------------------------------------------------------------- ! define functions used in the above subroutines From 9eccea6a18752ad0a30aaee2556771923f755325 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 9 Jan 2018 09:35:26 -0600 Subject: [PATCH 13/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/shoebox3_surface_forcing.F90 modified: src/user/channel5_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/shoebox3_surface_forcing.F90 | 305 ++++++++++++++++++ src/user/channel5_initialization.F90 | 2 +- 3 files changed, 315 insertions(+), 1 deletion(-) create mode 100644 config_src/solo_driver/shoebox3_surface_forcing.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 5755206772..f2d0942529 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -81,6 +81,8 @@ module MOM_surface_forcing use Neverland_surface_forcing, only : Neverland_surface_forcing_init, Neverland_surface_forcing_CS use shoebox_surface_forcing, only : shoebox_wind_forcing, shoebox_buoyancy_forcing use shoebox_surface_forcing, only : shoebox_surface_forcing_init, shoebox_surface_forcing_CS +use shoebox3_surface_forcing, only : shoebox3_buoyancy_forcing, shoebox3_wind_forcing +use shoebox3_surface_forcing, only : shoebox3_surface_forcing_init, shoebox3_surface_forcing_CS use channel_surface_forcing, only : channel_wind_forcing, channel_buoyancy_forcing use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS use channel2_surface_forcing, only : channel2_wind_forcing, channel2_buoyancy_forcing @@ -213,6 +215,7 @@ module MOM_surface_forcing type(MESO_surface_forcing_CS), pointer :: MESO_forcing_CSp => NULL() type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL() type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() + type(shoebox3_surface_forcing_CS), pointer :: shoebox3_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() type(channel2_surface_forcing_CS), pointer :: channel2_forcing_CSp => NULL() type(channel3_surface_forcing_CS), pointer :: channel3_forcing_CSp => NULL() @@ -304,6 +307,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call Neverland_wind_forcing(sfc_state, forces, day_center, G, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox") then call shoebox_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox3") then + call shoebox3_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then @@ -344,6 +349,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call Neverland_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%Neverland_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox") then call shoebox_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox3") then + call shoebox3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%buoy_config) == "channel") then call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) elseif (trim(CS%buoy_config) == "channel2") then @@ -1835,6 +1842,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call Neverland_surface_forcing_init(Time, G, param_file, diag, CS%Neverland_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox") then call shoebox_surface_forcing_init(Time, G, param_file, diag, CS%shoebox_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox3") then + call shoebox3_surface_forcing_init(Time, G, param_file, diag, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then diff --git a/config_src/solo_driver/shoebox3_surface_forcing.F90 b/config_src/solo_driver/shoebox3_surface_forcing.F90 new file mode 100644 index 0000000000..ccd9b25d30 --- /dev/null +++ b/config_src/solo_driver/shoebox3_surface_forcing.F90 @@ -0,0 +1,305 @@ +!> Wind and buoyancy forcing for the shoebox3 configurations +module shoebox3_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox3_buoyancy_forcing +public shoebox3_wind_forcing +public shoebox3_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox3 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox3_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox3_buoyancy_forcing has been called +end type shoebox3_surface_forcing_CS + +contains + + +subroutine shoebox3_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox3_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.25 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox3_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox3_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox3_buoyancy_forcing + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox3 forcing configuration. +subroutine shoebox3_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface + !state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox3_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox3_wind_forcing + + + + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox3 control structure. +subroutine shoebox3_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox3_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox3_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox3_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox3_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox3_surface_forcing diff --git a/src/user/channel5_initialization.F90 b/src/user/channel5_initialization.F90 index 58de29d8dc..54c6ff06e1 100644 --- a/src/user/channel5_initialization.F90 +++ b/src/user/channel5_initialization.F90 @@ -66,7 +66,7 @@ subroutine channel5_initialize_topography(D, G, param_file, max_depth) ssp = ssp/latext D = 0.0 dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext - dy = (G%geoLatT(is,js+1)-G%geoLatT(is,js))/latext + dy = (G%geoLatT(is,2)-G%geoLatT(is,1))/latext print *, 'dy=', dy From 8c3b7dc811a61dde42338e5318b24eaf33239fbc Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Wed, 10 Jan 2018 10:27:10 -0600 Subject: [PATCH 14/26] modified: config_src/solo_driver/channel3_surface_forcing.F90 modified: config_src/solo_driver/shoebox3_surface_forcing.F90 modified: src/user/channel4_initialization.F90 --- .../solo_driver/channel3_surface_forcing.F90 | 42 +++++++++++++++---- .../solo_driver/shoebox3_surface_forcing.F90 | 2 +- src/user/channel4_initialization.F90 | 11 ++--- 3 files changed, 42 insertions(+), 13 deletions(-) diff --git a/config_src/solo_driver/channel3_surface_forcing.F90 b/config_src/solo_driver/channel3_surface_forcing.F90 index 742d3bdea9..a093a0dd0d 100644 --- a/config_src/solo_driver/channel3_surface_forcing.F90 +++ b/config_src/solo_driver/channel3_surface_forcing.F90 @@ -1,10 +1,8 @@ -!> Wind and buoyancy forcing for the channel3 configurations +!> Wind and buoyancy forcing for the channel 3 configurations !> difference from channel: adjusted surface buoyancy profile so that the !> sigma_2 value is used, not surface value - -!> difference from channel2: -!> surface wind is turned off, so as to compare the result from using no -!diapycnal diffusivity but with wind +!> difference from channel 2: new surface density profile is used, +!> to be used in conjunction with rho 8 module channel3_surface_forcing @@ -62,13 +60,43 @@ subroutine channel3_wind_forcing(sfc_state, forces, day, G, CS) type(time_type), intent(in) :: day !< Time used for determining the fluxes. type(ocean_grid_type), intent(inout) :: G !< Grid structure. type(channel3_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext - ! wind stress is 0 everywhere + wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true.) + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo end subroutine channel3_wind_forcing @@ -86,7 +114,7 @@ subroutine channel3_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. real :: y, latext ! ND latitude, latitudinal range - real :: den, rhos = 1037.370, rhon = 1034.209 ! sothern and northern boundary densities of the channel3 + real :: den, rhos = 1037.5, rhon = 1034.162 ! sothern and northern boundary densities of the channel3 integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed diff --git a/config_src/solo_driver/shoebox3_surface_forcing.F90 b/config_src/solo_driver/shoebox3_surface_forcing.F90 index ccd9b25d30..c308de3bfe 100644 --- a/config_src/solo_driver/shoebox3_surface_forcing.F90 +++ b/config_src/solo_driver/shoebox3_surface_forcing.F90 @@ -56,7 +56,7 @@ subroutine shoebox3_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) real :: buoy_rest_const ! A constant relating density anomalies to the ! restoring buoyancy flux, in m5 s-3 kg-1. real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N - real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.25 ! south, equator, north + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.5 ! south, equator, north integer :: i, j, is, ie, js, je integer :: isd, ied, jsd, jed diff --git a/src/user/channel4_initialization.F90 b/src/user/channel4_initialization.F90 index 2ba0f9eef4..34137a991d 100644 --- a/src/user/channel4_initialization.F90 +++ b/src/user/channel4_initialization.F90 @@ -157,11 +157,12 @@ subroutine channel4_initialize_sponges(G, GV, use_temperature, tv, param_file, C dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon ! target interface heights: all negative values - ! corresponds to rho 7 - eta0 = (/0.0,0.0,0.0,-49.0,-99.0,-152.0,-211.0,-281.0,-361.0,-450.0, & - -550.0,-659.0,-779.0,-909.0,-1048.0,-1197.0,-1356.0, & - -1527.0,-1706.0,-1896.0,-2095.0,-2311.0,-2529.0,-2753.0, & - -2995.0,-3246.0,-3498.0,-3746.0,-4000.0,-4000.0,-4000.0 /) + ! corresponds to rho 8 + eta0 = (/0., 0., 0., 0., 0., & + -64.,-140.,-244.,-372.,-520.,-676.,-834.,-996., & + -1161.,-1328.,-1501.,-1675.,-1851.,-2030.,-2214.,-2399., & + -2592.,-2779.,-2979.,-3179.,-3382.,-3583.,-3786., & + -4000., -4000., -4000. /) if (first_call) call log_version(param_file, mdl, version) first_call = .false. From d661a91675640b4207293d380ac59bac70fb7a14 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Wed, 10 Jan 2018 21:42:54 -0600 Subject: [PATCH 15/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/shoebox4_surface_forcing.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/shoebox4_surface_forcing.F90 | 306 ++++++++++++++++++ 2 files changed, 315 insertions(+) create mode 100644 config_src/solo_driver/shoebox4_surface_forcing.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index f2d0942529..4d6cf6f063 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -83,6 +83,8 @@ module MOM_surface_forcing use shoebox_surface_forcing, only : shoebox_surface_forcing_init, shoebox_surface_forcing_CS use shoebox3_surface_forcing, only : shoebox3_buoyancy_forcing, shoebox3_wind_forcing use shoebox3_surface_forcing, only : shoebox3_surface_forcing_init, shoebox3_surface_forcing_CS +use shoebox4_surface_forcing, only : shoebox4_buoyancy_forcing, shoebox4_wind_forcing +use shoebox4_surface_forcing, only : shoebox4_surface_forcing_init, shoebox4_surface_forcing_CS use channel_surface_forcing, only : channel_wind_forcing, channel_buoyancy_forcing use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS use channel2_surface_forcing, only : channel2_wind_forcing, channel2_buoyancy_forcing @@ -216,6 +218,7 @@ module MOM_surface_forcing type(Neverland_surface_forcing_CS), pointer :: Neverland_forcing_CSp => NULL() type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() type(shoebox3_surface_forcing_CS), pointer :: shoebox3_forcing_CSp => NULL() + type(shoebox4_surface_forcing_CS), pointer :: shoebox4_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() type(channel2_surface_forcing_CS), pointer :: channel2_forcing_CSp => NULL() type(channel3_surface_forcing_CS), pointer :: channel3_forcing_CSp => NULL() @@ -309,6 +312,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox3") then call shoebox3_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox3_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox4") then + call shoebox4_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox4_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then @@ -351,6 +356,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox3") then call shoebox3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox3_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox4") then + call shoebox4_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox4_forcing_CSp) elseif (trim(CS%buoy_config) == "channel") then call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) elseif (trim(CS%buoy_config) == "channel2") then @@ -1844,6 +1851,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call shoebox_surface_forcing_init(Time, G, param_file, diag, CS%shoebox_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox3") then call shoebox3_surface_forcing_init(Time, G, param_file, diag, CS%shoebox3_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox4") then + call shoebox4_surface_forcing_init(Time, G, param_file, diag, CS%shoebox4_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then diff --git a/config_src/solo_driver/shoebox4_surface_forcing.F90 b/config_src/solo_driver/shoebox4_surface_forcing.F90 new file mode 100644 index 0000000000..f7574b1b62 --- /dev/null +++ b/config_src/solo_driver/shoebox4_surface_forcing.F90 @@ -0,0 +1,306 @@ +!> Wind and buoyancy forcing for the shoebox4 configurations +!> difference from shoebox3: wind stress in the SO is weakend by a factor of 2 +module shoebox4_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox4_buoyancy_forcing +public shoebox4_wind_forcing +public shoebox4_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox4 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox4_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox4_buoyancy_forcing has been called +end type shoebox4_surface_forcing_CS + +contains + + +subroutine shoebox4_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox4_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.5 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox4_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox4_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox4_buoyancy_forcing + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox4 forcing configuration. +subroutine shoebox4_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface + !state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox4_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + wp_SO = 0.13961/2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox4_wind_forcing + + + + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox4 control structure. +subroutine shoebox4_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox4_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox4_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox4_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox4_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox4_surface_forcing From fef0e6e6a253aa3726a39e3569c3de318cdc979d Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 30 Jan 2018 10:13:59 -0600 Subject: [PATCH 16/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/channel4_surface_forcing.F90 new file: config_src/solo_driver/channel5_surface_forcing.F90 new file: config_src/solo_driver/channel6_surface_forcing.F90 new file: config_src/solo_driver/shoebox8_surface_forcing.F90 new file: config_src/solo_driver/shoebox9_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 modified: src/user/channel4_initialization.F90 deleted: src/user/channel5_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 45 +++ .../solo_driver/channel4_surface_forcing.F90 | 274 ++++++++++++++++ .../solo_driver/channel5_surface_forcing.F90 | 275 ++++++++++++++++ .../solo_driver/channel6_surface_forcing.F90 | 275 ++++++++++++++++ .../solo_driver/shoebox8_surface_forcing.F90 | 306 ++++++++++++++++++ .../solo_driver/shoebox9_surface_forcing.F90 | 306 ++++++++++++++++++ .../MOM_fixed_initialization.F90 | 3 - src/user/channel4_initialization.F90 | 11 +- src/user/channel5_initialization.F90 | 203 ------------ 9 files changed, 1488 insertions(+), 210 deletions(-) create mode 100644 config_src/solo_driver/channel4_surface_forcing.F90 create mode 100644 config_src/solo_driver/channel5_surface_forcing.F90 create mode 100644 config_src/solo_driver/channel6_surface_forcing.F90 create mode 100644 config_src/solo_driver/shoebox8_surface_forcing.F90 create mode 100644 config_src/solo_driver/shoebox9_surface_forcing.F90 delete mode 100644 src/user/channel5_initialization.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 4d6cf6f063..6db62468ae 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -85,12 +85,22 @@ module MOM_surface_forcing use shoebox3_surface_forcing, only : shoebox3_surface_forcing_init, shoebox3_surface_forcing_CS use shoebox4_surface_forcing, only : shoebox4_buoyancy_forcing, shoebox4_wind_forcing use shoebox4_surface_forcing, only : shoebox4_surface_forcing_init, shoebox4_surface_forcing_CS +use shoebox8_surface_forcing, only : shoebox8_buoyancy_forcing,shoebox8_wind_forcing +use shoebox8_surface_forcing, only : shoebox8_surface_forcing_init, shoebox8_surface_forcing_CS +use shoebox9_surface_forcing, only : shoebox9_buoyancy_forcing, shoebox9_wind_forcing +use shoebox9_surface_forcing, only : shoebox9_surface_forcing_init, shoebox9_surface_forcing_CS use channel_surface_forcing, only : channel_wind_forcing, channel_buoyancy_forcing use channel_surface_forcing, only : channel_surface_forcing_init, channel_surface_forcing_CS use channel2_surface_forcing, only : channel2_wind_forcing, channel2_buoyancy_forcing use channel2_surface_forcing, only : channel2_surface_forcing_init, channel2_surface_forcing_CS use channel3_surface_forcing, only : channel3_wind_forcing, channel3_buoyancy_forcing use channel3_surface_forcing, only : channel3_surface_forcing_init, channel3_surface_forcing_CS +use channel4_surface_forcing, only : channel4_wind_forcing, channel4_buoyancy_forcing +use channel4_surface_forcing, only : channel4_surface_forcing_init, channel4_surface_forcing_CS +use channel5_surface_forcing, only : channel5_wind_forcing, channel5_buoyancy_forcing +use channel5_surface_forcing, only : channel5_surface_forcing_init, channel5_surface_forcing_CS +use channel6_surface_forcing, only : channel6_wind_forcing, channel6_buoyancy_forcing +use channel6_surface_forcing, only : channel6_surface_forcing_init, channel6_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -219,9 +229,14 @@ module MOM_surface_forcing type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() type(shoebox3_surface_forcing_CS), pointer :: shoebox3_forcing_CSp => NULL() type(shoebox4_surface_forcing_CS), pointer :: shoebox4_forcing_CSp => NULL() + type(shoebox8_surface_forcing_CS), pointer :: shoebox8_forcing_CSp => NULL() + type(shoebox9_surface_forcing_CS), pointer :: shoebox9_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() type(channel2_surface_forcing_CS), pointer :: channel2_forcing_CSp => NULL() type(channel3_surface_forcing_CS), pointer :: channel3_forcing_CSp => NULL() + type(channel4_surface_forcing_CS), pointer :: channel4_forcing_CSp => NULL() + type(channel5_surface_forcing_CS), pointer :: channel5_forcing_CSp => NULL() + type(channel6_surface_forcing_CS), pointer :: channel6_forcing_CSp => NULL() type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() @@ -314,12 +329,22 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox3_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox4") then call shoebox4_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox4_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox8") then + call shoebox8_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox8_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox9") then + call shoebox9_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox9_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_wind_forcing(sfc_state, forces, day_center, G, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then call channel2_wind_forcing(sfc_state, forces, day_center, G, CS%channel2_forcing_CSp) elseif (trim(CS%wind_config) == "channel3") then call channel3_wind_forcing(sfc_state, forces, day_center, G, CS%channel3_forcing_CSp) + elseif (trim(CS%wind_config) == "channel4") then + call channel4_wind_forcing(sfc_state, forces, day_center, G, CS%channel4_forcing_CSp) + elseif (trim(CS%wind_config) == "channel5") then + call channel5_wind_forcing(sfc_state, forces, day_center, G, CS%channel5_forcing_CSp) + elseif (trim(CS%wind_config) == "channel6") then + call channel6_wind_forcing(sfc_state, forces, day_center, G, CS%channel6_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then @@ -358,12 +383,22 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox4") then call shoebox4_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox4_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox8") then + call shoebox8_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox8_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox9") then + call shoebox9_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox9_forcing_CSp) elseif (trim(CS%buoy_config) == "channel") then call channel_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel_forcing_CSp) elseif (trim(CS%buoy_config) == "channel2") then call channel2_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel2_forcing_CSp) elseif (trim(CS%buoy_config) == "channel3") then call channel3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel3_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel4") then + call channel4_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel4_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel5") then + call channel5_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel5_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel6") then + call channel6_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel6_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then @@ -1853,12 +1888,22 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call shoebox3_surface_forcing_init(Time, G, param_file, diag, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox4") then call shoebox4_surface_forcing_init(Time, G, param_file, diag, CS%shoebox4_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox8") then + call shoebox8_surface_forcing_init(Time, G, param_file, diag, CS%shoebox8_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox9") then + call shoebox9_surface_forcing_init(Time, G, param_file, diag, CS%shoebox9_forcing_CSp) elseif (trim(CS%wind_config) == "channel") then call channel_surface_forcing_init(Time, G, param_file, diag, CS%channel_forcing_CSp) elseif (trim(CS%wind_config) == "channel2") then call channel2_surface_forcing_init(Time, G, param_file, diag, CS%channel2_forcing_CSp) elseif (trim(CS%wind_config) == "channel3") then call channel3_surface_forcing_init(Time, G, param_file, diag, CS%channel3_forcing_CSp) + elseif (trim(CS%wind_config) == "channel4") then + call channel4_surface_forcing_init(Time, G, param_file, diag, CS%channel4_forcing_CSp) + elseif (trim(CS%wind_config) == "channel5") then + call channel5_surface_forcing_init(Time, G, param_file, diag, CS%channel5_forcing_CSp) + elseif (trim(CS%wind_config) == "channel6") then + call channel6_surface_forcing_init(Time, G, param_file, diag, CS%channel6_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then diff --git a/config_src/solo_driver/channel4_surface_forcing.F90 b/config_src/solo_driver/channel4_surface_forcing.F90 new file mode 100644 index 0000000000..85a25e3d34 --- /dev/null +++ b/config_src/solo_driver/channel4_surface_forcing.F90 @@ -0,0 +1,274 @@ +!> Wind and buoyancy forcing for the channel 3 configurations +!> difference from channel: adjusted surface buoyancy profile so that the +!> sigma_2 value is used, not surface value +!> difference from channel 2: new surface density profile is used, +!> to be used in conjunction with rho 8 + +module channel4_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel4_wind_forcing +public channel4_buoyancy_forcing +public channel4_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel4 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel4_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel4_buoyancy_forcing has been called +end type channel4_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel4 forcing configuration. +subroutine channel4_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel4_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel4_wind_forcing + + +!> Surface fluxes of buoyancy for the channel4 configurations. +subroutine channel4_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel4_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.5, rhon = 1034.162 ! sothern and northern boundary densities of the channel4 + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel4_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel4_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel4_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel4 control structure. +subroutine channel4_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel4_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel4_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel4_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel4_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel4_surface_forcing diff --git a/config_src/solo_driver/channel5_surface_forcing.F90 b/config_src/solo_driver/channel5_surface_forcing.F90 new file mode 100644 index 0000000000..4200fbf12f --- /dev/null +++ b/config_src/solo_driver/channel5_surface_forcing.F90 @@ -0,0 +1,275 @@ +!> Wind and buoyancy forcing for the channel 4 configurations +!> difference from channel: adjusted surface buoyancy profile so that the +!> sigma_2 value is used, not surface value +!> difference from channel 2: new surface density profile is used, +!> to be used in conjunction with rho 8 +!> surface wind peak is 0.14/2 + +module channel5_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel5_wind_forcing +public channel5_buoyancy_forcing +public channel5_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel5 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel5_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel5_buoyancy_forcing has been called +end type channel5_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel5 forcing configuration. +subroutine channel5_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel5_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.13961/2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel5_wind_forcing + + +!> Surface fluxes of buoyancy for the channel5 configurations. +subroutine channel5_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel5_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.5, rhon = 1034.162 ! sothern and northern boundary densities of the channel5 + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel5_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel5_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel5_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel5 control structure. +subroutine channel5_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel5_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel5_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel5_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel5_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel5_surface_forcing diff --git a/config_src/solo_driver/channel6_surface_forcing.F90 b/config_src/solo_driver/channel6_surface_forcing.F90 new file mode 100644 index 0000000000..0b81812743 --- /dev/null +++ b/config_src/solo_driver/channel6_surface_forcing.F90 @@ -0,0 +1,275 @@ +!> Wind and buoyancy forcing for the channel 6 configurations +!> difference from channel: adjusted surface buoyancy profile so that the +!> sigma_2 value is used, not surface value +!> difference from channel 2: new surface density profile is used, +!> to be used in conjunction with rho 8 +!> surface wind peak is 0.13961*2 + +module channel6_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel6_wind_forcing +public channel6_buoyancy_forcing +public channel6_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel6 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel6_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel6_buoyancy_forcing has been called +end type channel6_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel6 forcing configuration. +subroutine channel6_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel6_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.13961*2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel6_wind_forcing + + +!> Surface fluxes of buoyancy for the channel6 configurations. +subroutine channel6_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel6_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.5, rhon = 1034.162 ! sothern and northern boundary densities of the channel6 + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel6_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel6_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel6_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel6 control structure. +subroutine channel6_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel6_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel6_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel6_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel6_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel6_surface_forcing diff --git a/config_src/solo_driver/shoebox8_surface_forcing.F90 b/config_src/solo_driver/shoebox8_surface_forcing.F90 new file mode 100644 index 0000000000..6c119d50b0 --- /dev/null +++ b/config_src/solo_driver/shoebox8_surface_forcing.F90 @@ -0,0 +1,306 @@ +!> Wind and buoyancy forcing for the shoebox8 configurations +module shoebox8_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox8_buoyancy_forcing +public shoebox8_wind_forcing +public shoebox8_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox8 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox8_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox8_buoyancy_forcing has been called +end type shoebox8_surface_forcing_CS + +contains + + +subroutine shoebox8_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox8_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.5 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox8_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox8_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox8_buoyancy_forcing + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox8 forcing configuration. +subroutine shoebox8_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface + !state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox8_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + ! wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp_SO = 0.2 ! new southern ocean wind stress peak; new for shoebox8 + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox8_wind_forcing + + + + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox8 control structure. +subroutine shoebox8_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox8_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox8_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox8_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox8_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox8_surface_forcing diff --git a/config_src/solo_driver/shoebox9_surface_forcing.F90 b/config_src/solo_driver/shoebox9_surface_forcing.F90 new file mode 100644 index 0000000000..e7963b9c46 --- /dev/null +++ b/config_src/solo_driver/shoebox9_surface_forcing.F90 @@ -0,0 +1,306 @@ +!> Wind and buoyancy forcing for the shoebox9 configurations +module shoebox9_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox9_buoyancy_forcing +public shoebox9_wind_forcing +public shoebox9_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox9 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox9_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox9_buoyancy_forcing has been called +end type shoebox9_surface_forcing_CS + +contains + + +subroutine shoebox9_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox9_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.5 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox9_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox9_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox9_buoyancy_forcing + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox9 forcing configuration. +subroutine shoebox9_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface + !state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox9_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + !wp_SO = 0.13961 ! westerly peak in SO; 53 S + wp_SO = 0.17 + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox9_wind_forcing + + + + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox9 control structure. +subroutine shoebox9_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox9_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox9_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox9_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox9_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox9_surface_forcing diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 0c03623371..e64449c11a 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -40,7 +40,6 @@ module MOM_fixed_initialization use channel2_initialization, only : channel2_initialize_topography use channel3_initialization, only : channel3_initialize_topography use channel4_initialization, only : channel4_initialize_topography -use channel5_initialization, only : channel5_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -214,7 +213,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t channel2 - use the channel2 test case topography. \n"//& " \t channel3 - use the channel3 test case topography. \n"//& " \t channel4 - use the channel4 test case topography. \n"//& - " \t channel5 - use the channel5 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& @@ -251,7 +249,6 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("channel2"); call channel2_initialize_topography(D, G, PF, max_depth) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) case ("channel4"); call channel4_initialize_topography(D, G, PF, max_depth) - case ("channel5"); call channel5_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) diff --git a/src/user/channel4_initialization.F90 b/src/user/channel4_initialization.F90 index 34137a991d..1a86d01510 100644 --- a/src/user/channel4_initialization.F90 +++ b/src/user/channel4_initialization.F90 @@ -34,6 +34,8 @@ module channel4_initialization !> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge !> 4) the shape of Drake Passage in the east is modified so as to match that in the west +!> update: 1/24/2018: use diagnosed vertical rho profile from sb8sG as sponge layer rho profile + subroutine channel4_initialize_topography(D, G, param_file, max_depth) type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type real, dimension(G%isd:G%ied,G%jsd:G%jed), & @@ -159,10 +161,11 @@ subroutine channel4_initialize_sponges(G, GV, use_temperature, tv, param_file, C ! target interface heights: all negative values ! corresponds to rho 8 eta0 = (/0., 0., 0., 0., 0., & - -64.,-140.,-244.,-372.,-520.,-676.,-834.,-996., & - -1161.,-1328.,-1501.,-1675.,-1851.,-2030.,-2214.,-2399., & - -2592.,-2779.,-2979.,-3179.,-3382.,-3583.,-3786., & - -4000., -4000., -4000. /) + -36., -74., -130., -203., -300., -400., -489., & + -567., -641., -712., -784., -858., -940., -1032., & + -1146., -1303., -1551., -1855., -2146., -2448., & + -2738., -3024., -3311., -3623., -3921., -4000. /) + if (first_call) call log_version(param_file, mdl, version) first_call = .false. diff --git a/src/user/channel5_initialization.F90 b/src/user/channel5_initialization.F90 deleted file mode 100644 index 54c6ff06e1..0000000000 --- a/src/user/channel5_initialization.F90 +++ /dev/null @@ -1,203 +0,0 @@ -module channel5_initialization - -! This file is part of MOM6. See LICENSE.md for the license. - -use MOM_dyn_horgrid, only : dyn_horgrid_type -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe -use MOM_get_input, only : directories -use MOM_grid, only : ocean_grid_type -use MOM_tracer_registry, only : tracer_registry_type -use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type - -implicit none ; private - -#include - -public channel5_initialize_topography - -! This include declares and sets the variable "version". -#include "version_variable.h" - -contains - - -! ----------------------------------------------------------------------------- -!> This subroutine sets up the channel5 test case topography. -!> channel5 is similar to channel but: -!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability -!> 2) the sponge layer has no slope -!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge -!> 4) the shape of Drake Passage in the east is modified so as to match that in the west -!> 5) the only difference from channel 4: Antarctica continental slope reaches -!> the southernmost latitude at surface, i.e. not halfway below sea surface, -!> by introducing a factor of dy (similar to dx) - -subroutine channel5_initialize_topography(D, G, param_file, max_depth) - type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type - real, dimension(G%isd:G%ied,G%jsd:G%jed), & - intent(out) :: D !< Ocean bottom depth in m - type(param_file_type), intent(in) :: param_file !< Parameter file structure - real, intent(in) :: max_depth !< Maximum depth of model in m - - real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) - real :: latext, lonext ! latitude extent of the model area - real :: ep = epsilon(1.) ! an infinitesimally small quantity - real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc - real :: sa ! the non-dimensional height of Scotia Arc top; - ! default value is 1500/4000=0.375 - real :: dx, dy ! non-dimensional longitudinal/latitudinal grid scale - real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern - ! boundary of the reentrant channel - real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width - - character(len=40) :: mod = "channel5_initialize_topography" ! This subroutine's name. - integer :: i, j, is, ie, js, je - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - - sa = sa_dim / max_depth - latext = G%len_lat - lonext = G%len_lon - reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone - reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone - sdp = sdp/latext - ssp = ssp/latext - D = 0.0 - dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext - dy = (G%geoLatT(is,2)-G%geoLatT(is,1))/latext - - print *, 'dy=', dy - - call MOM_mesg(" channel5_initialization.F90, channel5_initialize_topography: setting topography", 5) - - call log_version(param_file, mod, version, "") - - - ! Calculate the depth of the bottom. - do j = js,je ! meridional grid points - do i = is,ie ! zonal grid points - x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude - y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude - - D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west - -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original - -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope - -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west - -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original - -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope - -spike(y-dy, ll/latext) & ! Antarctica - - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center - - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope - - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope - - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) - - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half - - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) - - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half - - ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior - if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then - D(i,j) = 1 - sa - else if (D(i,j) > 1.0) then - D(i,j) = 1.0 - endif - - ! no continental slope in the sponge layer - if (y >= 1.0-ssp) then - D(i,j)=1.0 - endif - - ! make sure the model is not zonally reentrant outside of Drake Passage - if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then - D(i,j) = 0.0 - endif - - D(i,j) = D(i,j) * max_depth - enddo - enddo - - -end subroutine channel5_initialize_topography - - -! define functions used in the above subroutines - - -!> Returns the value of a sinusoidal bell function - real function spike(x,L) - - real, intent(in) :: x - real, intent(in) :: L - real :: PI = 4.0*atan(1.0) - - spike = 1-sin(PI*min(abs(x)/L, 0.5)) - - end function spike - -!> Returns the value of a cosine-bell function evaluated at x/L - real function cosbell(x,L) - - real , intent(in) :: x !< non-dimensional position - real , intent(in) :: L !< non-dimensional width - real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) - - cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) - end function cosbell - -!< Return the value of a half-cosine-bell function evaluated at x/L; -!< i.e. from peak to trough only on one side of the bell - real function cosbellh(x, L, dir) - - real, intent(in) :: x !< non-dimensional position - real, intent(in) :: L !< non-dimensional width - real :: PI, xx !< 3.1415926... calculated as 4*atan(1) - real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south - PI = 4.0*atan(1.0) - - !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 - if (x*dir .lt. 0.0) then - xx = L+1 - else - xx = x - endif - - cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) - end function cosbellh - - !< similar to cosbellh but takes a different shape of bell - real function cosbellhnew(x, L, dir) - - real, intent(in) :: x !< non-dimensional position - real, intent(in) :: L !< non-dimensional width - real :: PI, xx !< 3.1415926... calculated as 4*atan(1) - real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south - PI = 4.0*atan(1.0) - - !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 - if (x*dir .lt. 0.0) then - xx = L+1 - else - xx = x - endif - - cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) - end function cosbellhnew - - - !< make sure the depth within L is homogeneous - real function homo(x, L) - - real, intent(in) :: x !< non-dimensional position - real, intent(in) :: L !< non-dimensional width - - !< if x falls within -L ~ L, assign 1 to the non-dimensional depth - if (abs(x) .le. L) then - homo = 1.0 - else - homo = 0.0 - endif - end function homo - -end module channel5_initialization From b42983007d9b9263ba74558931b9b20af3667cdf Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 30 Jan 2018 10:50:50 -0600 Subject: [PATCH 17/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 modified: config_src/solo_driver/shoebox4_surface_forcing.F90 new file: config_src/solo_driver/shoebox5_surface_forcing.F90 modified: src/initialization/MOM_state_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/shoebox4_surface_forcing.F90 | 3 +- .../solo_driver/shoebox5_surface_forcing.F90 | 309 ++++++++++++++++++ .../MOM_state_initialization.F90 | 3 - 4 files changed, 320 insertions(+), 4 deletions(-) create mode 100644 config_src/solo_driver/shoebox5_surface_forcing.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index db2ee02fbc..7af8bab1ce 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -85,6 +85,8 @@ module MOM_surface_forcing use shoebox3_surface_forcing, only : shoebox3_surface_forcing_init, shoebox3_surface_forcing_CS use shoebox4_surface_forcing, only : shoebox4_buoyancy_forcing, shoebox4_wind_forcing use shoebox4_surface_forcing, only : shoebox4_surface_forcing_init, shoebox4_surface_forcing_CS +use shoebox5_surface_forcing, only : shoebox5_buoyancy_forcing, shoebox5_wind_forcing +use shoebox5_surface_forcing, only : shoebox5_surface_forcing_init, shoebox5_surface_forcing_CS use shoebox8_surface_forcing, only : shoebox8_buoyancy_forcing,shoebox8_wind_forcing use shoebox8_surface_forcing, only : shoebox8_surface_forcing_init, shoebox8_surface_forcing_CS use shoebox9_surface_forcing, only : shoebox9_buoyancy_forcing, shoebox9_wind_forcing @@ -231,6 +233,7 @@ module MOM_surface_forcing type(shoebox_surface_forcing_CS), pointer :: shoebox_forcing_CSp => NULL() type(shoebox3_surface_forcing_CS), pointer :: shoebox3_forcing_CSp => NULL() type(shoebox4_surface_forcing_CS), pointer :: shoebox4_forcing_CSp => NULL() + type(shoebox5_surface_forcing_CS), pointer :: shoebox5_forcing_CSp => NULL() type(shoebox8_surface_forcing_CS), pointer :: shoebox8_forcing_CSp => NULL() type(shoebox9_surface_forcing_CS), pointer :: shoebox9_forcing_CSp => NULL() type(channel_surface_forcing_CS), pointer :: channel_forcing_CSp => NULL() @@ -331,6 +334,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox3_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox4") then call shoebox4_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox4_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox5") then + call shoebox5_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox5_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox8") then call shoebox8_wind_forcing(sfc_state, forces, day_center, G, CS%shoebox8_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox9") then @@ -385,6 +390,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call shoebox3_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox3_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox4") then call shoebox4_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox4_forcing_CSp) + elseif (trim(CS%buoy_config) == "shoebox5") then + call shoebox5_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox5_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox8") then call shoebox8_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%shoebox8_forcing_CSp) elseif (trim(CS%buoy_config) == "shoebox9") then @@ -1894,6 +1901,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call shoebox3_surface_forcing_init(Time, G, param_file, diag, CS%shoebox3_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox4") then call shoebox4_surface_forcing_init(Time, G, param_file, diag, CS%shoebox4_forcing_CSp) + elseif (trim(CS%wind_config) == "shoebox5") then + call shoebox5_surface_forcing_init(Time, G, param_file, diag, CS%shoebox5_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox8") then call shoebox8_surface_forcing_init(Time, G, param_file, diag, CS%shoebox8_forcing_CSp) elseif (trim(CS%wind_config) == "shoebox9") then diff --git a/config_src/solo_driver/shoebox4_surface_forcing.F90 b/config_src/solo_driver/shoebox4_surface_forcing.F90 index f7574b1b62..33f780a7c7 100644 --- a/config_src/solo_driver/shoebox4_surface_forcing.F90 +++ b/config_src/solo_driver/shoebox4_surface_forcing.F90 @@ -1,5 +1,6 @@ !> Wind and buoyancy forcing for the shoebox4 configurations -!> difference from shoebox3: wind stress in the SO is weakend by a factor of 2 +!> difference from shoebox3: wind stress in the SO is amplified by a factor of 2 + module shoebox4_surface_forcing ! This file is part of MOM6. See LICENSE.md for the license. diff --git a/config_src/solo_driver/shoebox5_surface_forcing.F90 b/config_src/solo_driver/shoebox5_surface_forcing.F90 new file mode 100644 index 0000000000..d2d87c8491 --- /dev/null +++ b/config_src/solo_driver/shoebox5_surface_forcing.F90 @@ -0,0 +1,309 @@ +!> Wind and buoyancy forcing for the shoebox5 configurations +!> difference from shoebox3: +!> 1) wind stress peak in SO is 0.2 Pa +!> 2) rho(65N) = rho(65S) - 0.3 + +module shoebox5_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public shoebox5_buoyancy_forcing +public shoebox5_wind_forcing +public shoebox5_surface_forcing_init + +!> This control structure should be used to store any run-time variables +!! associated with the shoebox5 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: shoebox5_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until shoebox5_buoyancy_forcing has been called +end type shoebox5_surface_forcing_CS + +contains + + +subroutine shoebox5_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox5_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext, sslat, eqlat ! dimensional: 65S; non-dimensional: 30S, Equator, 30N + real :: den, rho1 = 1037.5, rho2 = 1031.3, rho3 = 1037.2 ! south, equator, north + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat + sslat = G%south_lat + eqlat = -sslat/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "shoebox5_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + +! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y <= eqlat) then + CS%buoy_restore(is,j) = (rho2-rho1)/eqlat*y+rho1 ! southern hemisphere + else + CS%buoy_restore(is,j) = (rho3-rho2)/(1.0-eqlat)*(y-eqlat)+rho2 ! northern hemisphere + endif + enddo + + ! set up the profile for all the other longitudes + do i = is+1, ie + CS%buoy_restore(i, :)=CS%buoy_restore(is, :) + enddo + + endif + + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "shoebox5_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + else ! density is used to restore buoyancy + + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + + endif + endif + +end subroutine shoebox5_buoyancy_forcing + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! shoebox5 forcing configuration. +subroutine shoebox5_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface + !state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(shoebox5_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, wp3, wp4, wp5, wp6, latext, lonext + + wp_SO = 0.2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + wp3 = 0.03060 ! easterly trough near the equator; 4.75N + wp4 = -0.07131 ! esterly peak in Northern subtropics; 18.25N + wp5 = 0.09285 ! westerly peak in northern extratropics; 52.75N + wp6 = -0.10309 ! the northernmost point + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) & ! profile in Southern subtropics + + wp3*cosbell(y-69.0/latext, 9.0/latext) & ! (adjusted by 1.3) equator + + wp4*cosbell(y-83.0/latext, 26.0/latext) & ! northern subtropics + + wp5*cosbell(y-117.0/latext, 32.0/latext) & ! northern extratropics + + wp6*cosbell(y-132.5/latext, 11.0/latext) ! (adjusted by 4) northern boundary + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine shoebox5_wind_forcing + + + + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the shoebox5 control structure. +subroutine shoebox5_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(shoebox5_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "shoebox5_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "shoebox5_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine shoebox5_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + +end module shoebox5_surface_forcing diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 8f8da58d20..a9eb79b2e2 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -539,7 +539,6 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & PF, sponge_CSp, h) case ("BFB"); call BFB_initialize_sponges_southonly(G, use_temperature, tv, & PF, sponge_CSp, h) -<<<<<<< HEAD case ("channel"); call channel_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) case ("channelssp"); call channelssp_initialize_sponges(G, GV, use_temperature, & @@ -548,10 +547,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channel4"); call channel4_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) -======= case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & PF, useALE, sponge_CSp, ALE_sponge_CSp) ->>>>>>> dev/gfdl case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & PF, sponge_CSp, h) case ("dense"); call dense_water_initialize_sponges(G, GV, tv, PF, useALE, & From fb2218f521c8efd43c30c383f8e66475055a291a Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 6 Feb 2018 17:36:07 -0600 Subject: [PATCH 18/26] modified: config_src/solo_driver/MOM_surface_forcing.F90 new file: config_src/solo_driver/channel7_surface_forcing.F90 modified: src/initialization/MOM_fixed_initialization.F90 modified: src/initialization/MOM_state_initialization.F90 new file: src/user/channel5_initialization.F90 new file: src/user/channel7_initialization.F90 --- .../solo_driver/MOM_surface_forcing.F90 | 9 + .../solo_driver/channel7_surface_forcing.F90 | 278 ++++++++++++++++ .../MOM_fixed_initialization.F90 | 3 + .../MOM_state_initialization.F90 | 8 + src/user/channel5_initialization.F90 | 300 ++++++++++++++++++ src/user/channel7_initialization.F90 | 128 ++++++++ 6 files changed, 726 insertions(+) create mode 100644 config_src/solo_driver/channel7_surface_forcing.F90 create mode 100644 src/user/channel5_initialization.F90 create mode 100644 src/user/channel7_initialization.F90 diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 7af8bab1ce..9116f9a8ad 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -103,6 +103,8 @@ module MOM_surface_forcing use channel5_surface_forcing, only : channel5_surface_forcing_init, channel5_surface_forcing_CS use channel6_surface_forcing, only : channel6_wind_forcing, channel6_buoyancy_forcing use channel6_surface_forcing, only : channel6_surface_forcing_init, channel6_surface_forcing_CS +use channel7_surface_forcing, only : channel7_wind_forcing, channel7_buoyancy_forcing +use channel7_surface_forcing, only : channel7_surface_forcing_init, channel7_surface_forcing_CS use user_surface_forcing, only : USER_wind_forcing, USER_buoyancy_forcing use user_surface_forcing, only : USER_surface_forcing_init, user_surface_forcing_CS use user_revise_forcing, only : user_alter_forcing, user_revise_forcing_init @@ -242,6 +244,7 @@ module MOM_surface_forcing type(channel4_surface_forcing_CS), pointer :: channel4_forcing_CSp => NULL() type(channel5_surface_forcing_CS), pointer :: channel5_forcing_CSp => NULL() type(channel6_surface_forcing_CS), pointer :: channel6_forcing_CSp => NULL() + type(channel7_surface_forcing_CS), pointer :: channel7_forcing_CSp => NULL() type(SCM_idealized_hurricane_CS), pointer :: SCM_idealized_hurricane_CSp => NULL() type(SCM_CVmix_tests_CS), pointer :: SCM_CVmix_tests_CSp => NULL() @@ -352,6 +355,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call channel5_wind_forcing(sfc_state, forces, day_center, G, CS%channel5_forcing_CSp) elseif (trim(CS%wind_config) == "channel6") then call channel6_wind_forcing(sfc_state, forces, day_center, G, CS%channel6_forcing_CSp) + elseif (trim(CS%wind_config) == "channel7") then + call channel7_wind_forcing(sfc_state, forces, day_center, G, CS%channel7_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day_center, G, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "SCM_CVmix_tests") then @@ -408,6 +413,8 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, CS call channel5_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel5_forcing_CSp) elseif (trim(CS%buoy_config) == "channel6") then call channel6_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel6_forcing_CSp) + elseif (trim(CS%buoy_config) == "channel7") then + call channel7_buoyancy_forcing(sfc_state, fluxes, day_center, dt, G, CS%channel7_forcing_CSp) elseif (trim(CS%buoy_config) == "SCM_CVmix_tests") then call SCM_CVmix_tests_buoyancy_forcing(sfc_state, fluxes, day_center, G, CS%SCM_CVmix_tests_CSp) elseif (trim(CS%buoy_config) == "USER") then @@ -1919,6 +1926,8 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call channel5_surface_forcing_init(Time, G, param_file, diag, CS%channel5_forcing_CSp) elseif (trim(CS%wind_config) == "channel6") then call channel6_surface_forcing_init(Time, G, param_file, diag, CS%channel6_forcing_CSp) + elseif (trim(CS%wind_config) == "channel7") then + call channel7_surface_forcing_init(Time, G, param_file, diag, CS%channel7_forcing_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then diff --git a/config_src/solo_driver/channel7_surface_forcing.F90 b/config_src/solo_driver/channel7_surface_forcing.F90 new file mode 100644 index 0000000000..f63a3e0cd8 --- /dev/null +++ b/config_src/solo_driver/channel7_surface_forcing.F90 @@ -0,0 +1,278 @@ +!> Wind and buoyancy forcing for the channel 7 configurations +!> same wind configuration as channel 4, where peak wind stress in the SO = 0.2 Pa +!> different buoyancy config: in the range of sponge (32S-30S), density = rho(32S) +!> otherwise rho profile remains the same as channel 4 + +module channel7_surface_forcing + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : post_data, query_averaging_enabled +use MOM_diag_mediator, only : register_diag_field, diag_ctrl +use MOM_domains, only : pass_var, pass_vector, AGRID +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : allocate_forcing_type, allocate_mech_forcing +use MOM_grid, only : ocean_grid_type +use MOM_io, only : file_exists, read_data, slasher +use MOM_time_manager, only : time_type, operator(+), operator(/), get_time +use MOM_variables, only : surface + +implicit none ; private + +public channel7_wind_forcing +public channel7_buoyancy_forcing +public channel7_surface_forcing_init + + +!> This control structure should be used to store any run-time variables +!! associated with the channel7 forcing. It can be readily modified +!! for a specific case, and because it is private there will be no changes +!! needed in other code (although they will have to be recompiled). +type, public :: channel7_surface_forcing_CS ; private + + logical :: use_temperature !< If true, use temperature and salinity. + logical :: restorebuoy !< If true, use restoring surface buoyancy forcing. + real :: Rho0 !< The density used in the Boussinesq + !! approximation, in kg m-3. + real :: G_Earth !< The gravitational acceleration in m s-2. + real :: flux_const !< The restoring rate at the surface, in m s-1. + real, dimension(:,:), pointer :: & + buoy_restore(:,:) => NULL() !< The pattern to restore buoyancy to. + character(len=200) :: inputdir !< The directory where NetCDF input files are. + type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + !! timing of diagnostic output. + logical :: first_call = .true. !< True until channel7_buoyancy_forcing has been called +end type channel7_surface_forcing_CS + + +contains + + +!> Sets the surface wind stresses, forces%taux and forces%tauy for the +!! channel7 forcing configuration. +subroutine channel7_wind_forcing(sfc_state, forces, day, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel7_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variable + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB + + real :: x, y + real :: PI = 4.0*atan(1.0), wp_SO, wp2, latext, lonext + + wp_SO = 0.2 ! westerly peak in SO; 53 S + wp2 = -0.07871 ! easterly peak in Southern subtropics; 11.75S + forces%taux = 0.0 + latext = G%len_lat + lonext = G%len_lon + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + + ! Allocate the forcing arrays, if necessary. + call allocate_mech_forcing(G, forces, stress=.true.) + + ! Set the surface wind stresses, in units of Pa. A positive taux + ! accelerates the ocean to the (pseudo-)east. + do j = js, je + y=(G%geoLatT(is, j)-G%south_lat)/latext ! non-dimensional latitudes + forces%taux(is, j) = wp_SO*cosbellh(y-12.0/latext, 12.0/latext, -1.0) & ! south of the ACC peak + + wp2*cosbell(y-54.0/latext, 22.0/latext) ! profile in Southern subtropics + + if (y > 12.0/latext) then ! north of the ACC peak + forces%taux(is, j) = forces%taux(is, j)+ wp_SO*cosbell(y-12.0/latext, 25.0/latext) + endif + + do i = is+1, ie + forces%taux(i, j) = forces%taux(is, j) ! same wind stress for other longitudes + enddo + enddo + +end subroutine channel7_wind_forcing + + +!> Surface fluxes of buoyancy for the channel7 configurations. +subroutine channel7_buoyancy_forcing(sfc_state, fluxes, day, dt, G, CS) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(forcing), intent(inout) :: fluxes !< Forcing fields. + type(time_type), intent(in) :: day !< Time used for determining the fluxes. + real, intent(in) :: dt !< Forcing time step (s). + type(ocean_grid_type), intent(inout) :: G !< Grid structure. + type(channel7_surface_forcing_CS), pointer :: CS !< Control structure for this module. + ! Local variables + real :: buoy_rest_const ! A constant relating density anomalies to the + ! restoring buoyancy flux, in m5 s-3 kg-1. + real :: y, latext ! ND latitude, latitudinal range + real :: den, rhos = 1037.5, rhon = 1034.785, spongelen=2.0 + ! sothern and northern boundary densities of the channel7; latitudinal width of sponge + integer :: i, j, is, ie, js, je + integer :: isd, ied, jsd, jed + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + latext = G%len_lat; spongelen = spongelen/latext + + ! Allocate and zero out the forcing arrays, as necessary. This portion is + ! usually not changed. + if (CS%use_temperature) then + call MOM_error(FATAL, "channel7_buoyancy_forcing: " // & + "Temperature and salinity mode not coded!" ) + else + ! This is the buoyancy only mode. + call alloc_if_needed(fluxes%buoy, isd, ied, jsd, jed) + endif + + ! set up target surface density profile + if (CS%restorebuoy .and. CS%first_call) then + call alloc_if_needed(CS%buoy_restore, isd, ied, jsd, jed) + CS%first_call = .false. + + do j = js, je + y = (G%geoLatT(is,j)-G%south_lat)/latext ! non-dimensional latitude + if (y<1-spongelen) then ! if the point is outside of the sponge + CS%buoy_restore(is,j) = (rhon-rhos)*y+rhos ! linearly decreased density with latitudes + else ! otherwise rho is just rho(32S) + CS%buoy_restore(is,j) = (rhon-rhos)*(1-spongelen)+rhos + endif + enddo + ! set up the profile for all other longitudes + do i = is+1, ie + CS%buoy_restore(i,:)=CS%buoy_restore(is,:) + enddo + + endif + + ! compute the buoyancy flux needed to restore current density to target density + if (CS%restorebuoy) then + if (CS%use_temperature) then ! if temperature is used to restore buoyancy + call MOM_error(FATAL, "channel7_buoyancy_surface_forcing: " // & + "Temperature/salinity restoring not coded!" ) + + else ! density is used to restore buoyancy + ! The -1 is because density has the opposite sign to buoyancy. + buoy_rest_const = -1.0 * (CS%G_Earth * CS%flux_const) / CS%Rho0 + do j=js,je + do i=is,ie + fluxes%buoy(i,j) = G%mask2dT(i,j) * buoy_rest_const * & + (CS%buoy_restore(i, j) - sfc_state%sfc_density(i,j)) + enddo + enddo + endif + endif + +end subroutine channel7_buoyancy_forcing + +!> If ptr is not associated, this routine allocates it with the given size +!! and zeros out its contents. This is equivalent to safe_alloc_ptr in +!! MOM_diag_mediator, but is here so as to be completely transparent. +subroutine alloc_if_needed(ptr, isd, ied, jsd, jed) + real, pointer :: ptr(:,:) + integer :: isd, ied, jsd, jed + if (.not.ASSOCIATED(ptr)) then + allocate(ptr(isd:ied,jsd:jed)) + ptr(:,:) = 0.0 + endif +end subroutine alloc_if_needed + +!> Initializes the channel7 control structure. +subroutine channel7_surface_forcing_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate diagnostic output. + type(channel7_surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control structure + !! for this module + ! This include declares and sets the variable "version". +#include "version_variable.h" + ! Local variables + character(len=40) :: mod = "channel7_surface_forcing" ! This module's name. + + if (associated(CS)) then + call MOM_error(WARNING, "channel7_surface_forcing_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + CS%diag => diag + + ! Read all relevant parameters and write them to the model log. + call log_version(param_file, mod, version, "") + call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + "If true, Temperature and salinity are used as state \n"//& + "variables.", default=.true.) + + call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + "The gravitational acceleration of the Earth.", & + units="m s-2", default = 9.80) + call get_param(param_file, mod, "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"//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0) +! call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & +! "The background gustiness in the winds.", units="Pa", & +! default=0.02) + + call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + "If true, the buoyancy fluxes drive the model back \n"//& + "toward some specified surface state with a rate \n"//& + "given by FLUXCONST.", default= .false.) + + if (CS%restorebuoy) then + call get_param(param_file, mod, "FLUXCONST", CS%flux_const, & + "The constant that relates the restoring surface fluxes \n"//& + "to the relative surface anomalies (akin to a piston \n"//& + "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 + endif + +end subroutine channel7_surface_forcing_init + +!------------------------------ defines the functions to used from above ---------------- + !> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI !< 3.1415926... calculated as 4*atan(1) + + PI = 4.0*atan(1.0) + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + + !< return the value of a half-cosine-bell function evaluated at x/L; + !< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + +end module channel7_surface_forcing diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 18cf8d72cc..7c030bb8d6 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -40,6 +40,7 @@ module MOM_fixed_initialization use channel2_initialization, only : channel2_initialize_topography use channel3_initialization, only : channel3_initialize_topography use channel4_initialization, only : channel4_initialize_topography +use channel5_initialization, only : channel5_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -214,6 +215,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t channel2 - use the channel2 test case topography. \n"//& " \t channel3 - use the channel3 test case topography. \n"//& " \t channel4 - use the channel4 test case topography. \n"//& + " \t channel5 - use the channel5 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& @@ -251,6 +253,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("channel2"); call channel2_initialize_topography(D, G, PF, max_depth) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) case ("channel4"); call channel4_initialize_topography(D, G, PF, max_depth) + case ("channel5"); call channel5_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index a9eb79b2e2..c3bfec3af7 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -61,6 +61,8 @@ module MOM_state_initialization use channelssp_initialization, only: channelssp_initialize_sponges use channel2_initialization, only: channel2_initialize_sponges use channel4_initialization, only: channel4_initialize_sponges +use channel5_initialization, only: channel5_initialize_sponges +use channel7_initialization, only: channel7_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -526,6 +528,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t channel - Sponge at the northern boundary of the domain\n"//& " \t channel2 - Sponge at the northern boundary of the domain\n"//& " \t channel4 - Sponge at the northern boundary of the domain\n"//& + " \t channel5 - Sponge at the northern boundary of the domain\n"//& + " \t channel7 - Sponge at the northern boundary of the domain\n"//& " \t channelssp - Sponge at the northern boundary of the domain but avoid e/w boundaries\n"//& " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") @@ -547,6 +551,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channel4"); call channel4_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel5"); call channel5_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) + case ("channel7"); call channel7_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & PF, useALE, sponge_CSp, ALE_sponge_CSp) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & diff --git a/src/user/channel5_initialization.F90 b/src/user/channel5_initialization.F90 new file mode 100644 index 0000000000..07fd6ad8cb --- /dev/null +++ b/src/user/channel5_initialization.F90 @@ -0,0 +1,300 @@ +module channel5_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel5_initialize_topography +public channel5_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel5 test case topography. +!> channel5 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge +!> 4) the shape of Drake Passage in the east is modified so as to match that in the west + +!> update: 1/24/2018: use diagnosed vertical rho profile from sb8sG as sponge layer rho profile + +subroutine channel5_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 2.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel5_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel5_initialization.F90, channel5_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + -spike(y, ll/latext) & ! Antarctica + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! no continental slope in the sponge layer + if (y >= 1.0-ssp) then + D(i,j)=1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel5_initialize_topography + + + +! ----------------------------------------------------------------------------- +!> 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. +! difference from channel 4 (default sponge): sponge spans 5 deg, instead of 2 deg, wide + +subroutine channel5_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 5.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel5_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + eta0 = (/0., 0., 0., 0., 0., & + -36., -74., -130., -203., -300., -400., -489., & + -567., -641., -712., -784., -858., -940., -1032., & + -1146., -1303., -1551., -1855., -2146., -2448., & + -2738., -3024., -3311., -3623., -3921., -4000. /) + + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel5_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel5_initialization diff --git a/src/user/channel7_initialization.F90 b/src/user/channel7_initialization.F90 new file mode 100644 index 0000000000..684c2bf781 --- /dev/null +++ b/src/user/channel7_initialization.F90 @@ -0,0 +1,128 @@ +module channel7_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel7_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel7 test case sponge. +!> where rho profile in the sponge is diagnosed from 3000y sb8sG simulation +!> at 32 S: southern edge of the sponge + +! ----------------------------------------------------------------------------- +!> 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 channel7_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel7_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho8a + eta0 = (/0., 0., 0., 0., 0., & + -4.2, -47.2, -104.5, -182.9, -292.4, & + -402.9, -498.5, -582.5, -660.2, -734.6, & + -808.3, -884.6, -966.9, -1059.7, -1174.0, & + -1329.0, -1566.3, -1861.5, -2148.0, -2439.3, & + -2730.5, -3008.3, -3289.6, -3581.8, -3894.1, -4000. /) + + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + +end subroutine channel7_initialize_sponges + +end module channel7_initialization From 34d9c316f253ab03c88eefc559af7fdeb8444275 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 20 Feb 2018 20:34:13 -0600 Subject: [PATCH 19/26] modified: src/initialization/MOM_state_initialization.F90 new file: src/user/channel47_initialization.F90 new file: src/user/channel4t_initialization.F90 new file: src/user/channel74_initialization.F90 --- .../MOM_state_initialization.F90 | 12 + src/user/channel47_initialization.F90 | 208 ++++++++++++++++++ src/user/channel4t_initialization.F90 | 208 ++++++++++++++++++ src/user/channel74_initialization.F90 | 130 +++++++++++ 4 files changed, 558 insertions(+) create mode 100644 src/user/channel47_initialization.F90 create mode 100644 src/user/channel4t_initialization.F90 create mode 100644 src/user/channel74_initialization.F90 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index c3bfec3af7..46afd47e5f 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -61,8 +61,11 @@ module MOM_state_initialization use channelssp_initialization, only: channelssp_initialize_sponges use channel2_initialization, only: channel2_initialize_sponges use channel4_initialization, only: channel4_initialize_sponges +use channel47_initialization, only: channel47_initialize_sponges +use channel4t_initialization, only: channel4t_initialize_sponges use channel5_initialization, only: channel5_initialize_sponges use channel7_initialization, only: channel7_initialize_sponges +use channel74_initialization, only: channel74_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness use lock_exchange_initialization, only : lock_exchange_initialize_thickness use external_gwave_initialization, only : external_gwave_initialize_thickness @@ -528,8 +531,11 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t channel - Sponge at the northern boundary of the domain\n"//& " \t channel2 - Sponge at the northern boundary of the domain\n"//& " \t channel4 - Sponge at the northern boundary of the domain\n"//& + " \t channel47 - Sponge at the northern boundary of the domain\n"//& + " \t channel4t - Sponge at the northern boundary of the domain\n"//& " \t channel5 - Sponge at the northern boundary of the domain\n"//& " \t channel7 - Sponge at the northern boundary of the domain\n"//& + " \t channel74 - Sponge at the northern boundary of the domain\n"//& " \t channelssp - Sponge at the northern boundary of the domain but avoid e/w boundaries\n"//& " \t\t for buoyancy-forced basin case.\n"//& " \t USER - call a user modified routine.", default="file") @@ -551,10 +557,16 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channel4"); call channel4_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel47"); call channel47_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) + case ("channel4t"); call channel4t_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("channel5"); call channel5_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) case ("channel7"); call channel7_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel74"); call channel74_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("DUMBBELL"); call dumbbell_initialize_sponges(G, GV, tv, & PF, useALE, sponge_CSp, ALE_sponge_CSp) case ("phillips"); call Phillips_initialize_sponges(G, use_temperature, tv, & diff --git a/src/user/channel47_initialization.F90 b/src/user/channel47_initialization.F90 new file mode 100644 index 0000000000..3b1620888b --- /dev/null +++ b/src/user/channel47_initialization.F90 @@ -0,0 +1,208 @@ +module channel47_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel47_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +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. +! +! difference from channel 4: use stratification at 32S to test the rebustmness +! of the sponge +! e.g. only eta0 is different + +subroutine channel47_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel47_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + + eta0 = (/0., 0., 0., 0., 0., & + -4.2, -47.2, -104.5, -182.9, -292.4, & + -402.9, -498.5, -582.5, -660.2, -734.6, & + -808.3, -884.6, -966.9, -1059.7, -1174.0, & + -1329.0, -1566.3, -1861.5, -2148.0, -2439.3, & + -2730.5, -3008.3, -3289.6, -3581.8, -3894.1, -4000. /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel47_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel47_initialization diff --git a/src/user/channel4t_initialization.F90 b/src/user/channel4t_initialization.F90 new file mode 100644 index 0000000000..6e6005353d --- /dev/null +++ b/src/user/channel4t_initialization.F90 @@ -0,0 +1,208 @@ +module channel4t_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel4t_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +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. +! +! difference from channel 4: use stratification at 32S to test the rebustmness +! of the sponge +! e.g. only eta0 is different + +subroutine channel4t_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel4t_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + + eta0 = (/0., 0., 0., 0., 0., & + 0.0, -27.2, -74.5, -132.9, -242.4, & + -352.9, -448.5, -532.5, -610.2, -684.6, & + -758.3, -834.6, -916.9, -1009.7, -1124.0, & + -1279.0, -1516.3, -1811.5, -2098.0, -2389.3, & + -2680.5, -2958.3, -3239.6, -3531.8, -3844.1, -4000. /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel4t_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel4t_initialization diff --git a/src/user/channel74_initialization.F90 b/src/user/channel74_initialization.F90 new file mode 100644 index 0000000000..9047e19b2f --- /dev/null +++ b/src/user/channel74_initialization.F90 @@ -0,0 +1,130 @@ +module channel74_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel74_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +contains + + +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel74 test case sponge. +!> where rho profile in the sponge is diagnosed from 3000y sb8sG simulation +!> at 32 S: southern edge of the sponge + +! ----------------------------------------------------------------------------- +!> 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. +! +! difference from channel 7: use the stratification from 30S, not 32S; so only eta0 differs +! +subroutine channel74_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel74_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho8a + + eta0 = (/0., 0., 0., 0., 0., & + -36., -74., -130., -203., -300., -400., -489., & + -567., -641., -712., -784., -858., -940., -1032., & + -1146., -1303., -1551., -1855., -2146., -2448., & + -2738., -3024., -3311., -3623., -3921., -4000. /) + + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + +end subroutine channel74_initialize_sponges + +end module channel74_initialization From a9b5f2ea3aedfa261916eb375ed8f6728b307ad8 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 27 Feb 2018 16:09:16 -0600 Subject: [PATCH 20/26] modified: src/initialization/MOM_state_initialization.F90 new file: src/user/channel42d_initialization.F90 modified: src/user/channel4_initialization.F90 new file: src/user/channel4tt_initialization.F90 new file: src/user/channel6_initialization.F90 new file: src/user/user_change_diffusivity_Hailu.F90 --- .../MOM_state_initialization.F90 | 12 + src/user/channel42d_initialization.F90 | 229 ++++++++++++++ src/user/channel4_initialization.F90 | 19 +- src/user/channel4tt_initialization.F90 | 208 +++++++++++++ src/user/channel6_initialization.F90 | 213 +++++++++++++ src/user/user_change_diffusivity_Hailu.F90 | 284 ++++++++++++++++++ 6 files changed, 958 insertions(+), 7 deletions(-) create mode 100644 src/user/channel42d_initialization.F90 create mode 100644 src/user/channel4tt_initialization.F90 create mode 100644 src/user/channel6_initialization.F90 create mode 100644 src/user/user_change_diffusivity_Hailu.F90 diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 46afd47e5f..0dadbca710 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -61,9 +61,12 @@ module MOM_state_initialization use channelssp_initialization, only: channelssp_initialize_sponges use channel2_initialization, only: channel2_initialize_sponges use channel4_initialization, only: channel4_initialize_sponges +use channel42d_initialization, only: channel42d_initialize_sponges use channel47_initialization, only: channel47_initialize_sponges use channel4t_initialization, only: channel4t_initialize_sponges +use channel4tt_initialization, only: channel4tt_initialize_sponges use channel5_initialization, only: channel5_initialize_sponges +use channel6_initialization, only: channel6_initialize_sponges use channel7_initialization, only: channel7_initialize_sponges use channel74_initialization, only: channel74_initialize_sponges use circle_obcs_initialization, only : circle_obcs_initialize_thickness @@ -533,7 +536,10 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & " \t channel4 - Sponge at the northern boundary of the domain\n"//& " \t channel47 - Sponge at the northern boundary of the domain\n"//& " \t channel4t - Sponge at the northern boundary of the domain\n"//& + " \t channel4tt - Sponge at the northern boundary of the domain\n"//& + " \t channel42d - Sponge at the northern boundary of the domain\n"//& " \t channel5 - Sponge at the northern boundary of the domain\n"//& + " \t channel6 - Sponge at the northern boundary of the domain\n"//& " \t channel7 - Sponge at the northern boundary of the domain\n"//& " \t channel74 - Sponge at the northern boundary of the domain\n"//& " \t channelssp - Sponge at the northern boundary of the domain but avoid e/w boundaries\n"//& @@ -561,8 +567,14 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & tv, PF, sponge_CSp, h) case ("channel4t"); call channel4t_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel4tt"); call channel4tt_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) + case ("channel42d"); call channel42d_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("channel5"); call channel5_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) + case ("channel6"); call channel6_initialize_sponges(G, GV, use_temperature, & + tv, PF, sponge_CSp, h) case ("channel7"); call channel7_initialize_sponges(G, GV, use_temperature, & tv, PF, sponge_CSp, h) case ("channel74"); call channel74_initialize_sponges(G, GV, use_temperature, & diff --git a/src/user/channel42d_initialization.F90 b/src/user/channel42d_initialization.F90 new file mode 100644 index 0000000000..56e6a4da63 --- /dev/null +++ b/src/user/channel42d_initialization.F90 @@ -0,0 +1,229 @@ +module channel42d_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel42d_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +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. +! +! difference from channel 4: restore to different eta at 30S, 31S, and 32S; i.e. +! sponge is 2D, not 1D + +subroutine channel42d_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0, eta1, eta2 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz, cnt + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel42d_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + + eta0 = (/0.14, 0.14, 0.14, 0.14, -3.0, & + -36., -74., -130., -203., -300., -400., -489., & + -567., -641., -712., -784., -858., -940., -1032., & + -1146., -1303., -1551., -1855., -2146., -2448., & + -2738., -3024., -3311., -3623., -3921., -4000. /) + + eta1 = (/0.13, 0.13, 0.13, 0.13, -2.0, & + -21.3, -60.9, -117.6, -193.4, -296.4, & + -401.6, -493.6, -575.0, -650.5, -723.2, & + -795.7, -871.0, -952.8, -1045.2, -1159.6, & + -1315.8, -1558.0, -1857.6, -2148.1, -2447.6, & + -2734.6, -3016.3, -3299.2, -3603.6, -3908.8, -4000.0 /) + + eta2 = (/.1, .1, .1, .1, -1.2, & + -4.2, -47.2, -104.5, -182.9, -292.4, & + -402.9, -498.5, -582.5, -660.2, -734.6, & + -808.3, -884.6, -966.9, -1059.7, -1174.0, & + -1329.0, -1566.3, -1861.4, -2150.5, -2447.0, & + -2730.4, -3008.1, -3289.4, -3583.9, -3894.1, -4000.0 /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; cnt=0; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + cnt = cnt+1 + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1 + if (cnt == 1) then ! 32S: restore to eta2 + eta(i,j,k) = eta2(k) + elseif (cnt == 2) then ! 31S: restore to eta1 + eta(i,j,k) = eta1(k) + elseif (cnt == 3) then ! 30S: restore to eta0 + eta(i,j,k) = eta0(k) + endif + enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel42d_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel42d_initialization diff --git a/src/user/channel4_initialization.F90 b/src/user/channel4_initialization.F90 index 1a86d01510..73556b7f0f 100644 --- a/src/user/channel4_initialization.F90 +++ b/src/user/channel4_initialization.F90 @@ -159,13 +159,18 @@ subroutine channel4_initialize_sponges(G, GV, use_temperature, tv, param_file, C dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon ! target interface heights: all negative values - ! corresponds to rho 8 - eta0 = (/0., 0., 0., 0., 0., & - -36., -74., -130., -203., -300., -400., -489., & - -567., -641., -712., -784., -858., -940., -1032., & - -1146., -1303., -1551., -1855., -2146., -2448., & - -2738., -3024., -3311., -3623., -3921., -4000. /) - + ! corresponds to rho8a (diagnosed from sb8sG, zonal mean along 30S) + + eta0 = (/0.139014429059522, 0.139014429059522, 0.139014429059522, & + 0.138097949711413, -3.03516385164754, -36.3033413229318, & + -74.3258283549342, -129.677962599130, -203.404488662194, & + -300.373813497609, -400.174464258654, -488.574700717268, & + -567.427597045898, -640.999226537244, -712.274279364224, & + -783.668835870151, -858.271678003772, -939.502461400525, & + -1031.69079589844, -1146.23940724340, -1303.42024809739, & + -1550.78595602101, -1854.75769463901, -2146.14440061335, & + -2448.03345598493, -2738.49512154715, -3023.71094621931, & + -3311.24889470881, -3622.51995738636, -3921.27119584517, -4000.0 /) if (first_call) call log_version(param_file, mdl, version) first_call = .false. diff --git a/src/user/channel4tt_initialization.F90 b/src/user/channel4tt_initialization.F90 new file mode 100644 index 0000000000..c5e2ca1fcb --- /dev/null +++ b/src/user/channel4tt_initialization.F90 @@ -0,0 +1,208 @@ +module channel4tt_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel4tt_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +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. +! +! difference from channel 4: use stratification at 32S to test the rebustmness +! of the sponge +! e.g. only eta0 is different + +subroutine channel4tt_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 2.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel4tt_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + + eta0 = (/0.14, 0.14, 0.14, 0.14, -3.0, & + -26.0, -27.2, -74.5, -132.9, -242.4, & + -352.9, -448.5, -532.5, -610.2, -684.6, & + -758.3, -834.6, -916.9, -1009.7, -1124.0, & + -1279.0, -1516.3, -1811.5, -2098.0, -2389.3, & + -2680.5, -2958.3, -3239.6, -3531.8, -3844.1, -4000. /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel4tt_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel4tt_initialization diff --git a/src/user/channel6_initialization.F90 b/src/user/channel6_initialization.F90 new file mode 100644 index 0000000000..ca1ed06226 --- /dev/null +++ b/src/user/channel6_initialization.F90 @@ -0,0 +1,213 @@ +module channel6_initialization + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_sponge, only : sponge_CS, initialize_sponge, set_up_sponge_field, Apply_sponge +use MOM_dyn_horgrid, only : dyn_horgrid_type +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_error_handler, only : MOM_mesg, MOM_error, FATAL, is_root_pe +use MOM_get_input, only : directories +use MOM_grid, only : ocean_grid_type +use MOM_tracer_registry, only : tracer_registry_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type +use MOM_EOS, only : calculate_density, calculate_density_derivs, EOS_type + +implicit none ; private + +#include + +public channel6_initialize_sponges + +! This include declares and sets the variable "version". +#include "version_variable.h" + +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. +! +! difference from channel 4: +! sponge layer set as 1 deg, to check if the recirculation can be damped +! same: both use diagnosed zonal mean vertical rho profile from sb8sG (without +! adjustment) + +subroutine channel6_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + ! so as to be used as input of set_coord_from_file + logical, intent(in) :: use_temperature !< Switch for temperature. + 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. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for model + !! parameter values. + type(sponge_CS), pointer :: CSp !< A pointer that is set to point to + !! the control structure for the + !! sponge module. + real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< Thickness field. - may not be used! + real :: eta(SZI_(G),SZJ_(G),SZK_(G)+1) ! A temporary array for eta, m. + ! eta only varies in z + real :: Idamp(SZI_(G),SZJ_(G)) ! The inverse damping rate, in s-1. + ! Idamp only varies in y; /= 0 only within the sponge layer + real, dimension(SZK_(G)+1) :: eta0 ! target interface heights for density class in the sponge layer + real :: damp_rate, damp, spongelen = 1.0, min_depth, nlat, dx + ! spongelen: thickness of sponge layer in dimensional degree + ! dx is non-dimensional longitudinal grid increment + integer :: i, j, k, is, ie, js, je, nz + logical, save :: first_call = .true. + character(len=40) :: mdl = "channel6_initialize_sponges" ! This subroutine's name + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + eta(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; eta0(:) = 0.0; + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon + + ! target interface heights: all negative values + ! corresponds to rho 8 + + eta0 = (/0.139014429059522, 0.139014429059522, 0.139014429059522, & + 0.138097949711413, -3.03516385164754, -36.3033413229318, & + -74.3258283549342, -129.677962599130, -203.404488662194, & + -300.373813497609, -400.174464258654, -488.574700717268, & + -567.427597045898, -640.999226537244, -712.274279364224, & + -783.668835870151, -858.271678003772, -939.502461400525, & + -1031.69079589844, -1146.23940724340, -1303.42024809739, & + -1550.78595602101, -1854.75769463901, -2146.14440061335, & + -2448.03345598493, -2738.49512154715, -3023.71094621931, & + -3311.24889470881, -3622.51995738636, -3921.27119584517, -4000.0 /) + + if (first_call) call log_version(param_file, mdl, version) + first_call = .false. + + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & + "The rate at which the zonal-mean sponges damp.", units="s-1", & + default = 1.0/(10.0*86400.0)) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & + "The minimum depth of the ocean.", units="m", default=0.0) + + + nlat = G%south_lat + G%len_lat ! should be -30.0 degree + + + ! initialize the damping rate so it is 0 outside of the sponge layer & + ! and increases linearly with latitude within the sponge layer + do i = is, ie; do j = js, je + if (G%geoLatT(i,j) >= nlat-spongelen) then + damp = damp_rate/spongelen * (G%geoLatT(i,j)-nlat+spongelen) + else + damp = 0.0 ! outside of the sponge + endif + + do k = 1,nz+1; eta(i,j,k) = eta0(k); enddo ! initialize target heights for each (lat,lon) grid + + if (G%bathyT(i,j) > min_depth) then ! bathT: Ocean bottom depth (positive) at tracer points, in m. + Idamp(i,j) = damp ! no need to divide this by 86400!!! + else + Idamp(i,j) = 0.0 + endif ! so that at the side walls, Idamp = 0 + enddo; enddo + + call initialize_sponge(Idamp, eta, G, param_file, CSp) + +!From MOM_sponge.F90 +!subroutine initialize_sponge(Idamp, eta, G, param_file, CSp, & +! Iresttime_i_mean, int_height_i_mean) +! +! Arguments: Idamp - The inverse of the restoring time, in s-1. +! (in) eta - The interface heights to damp back toward, in m. +! (in) G - The ocean's grid structure. +! (in) param_file - A structure indicating the open file to parse for +! model parameter values. +! (in/out) CSp - A pointer that is set to point to the control structure +! for this module + + +end subroutine channel6_initialize_sponges + + +! ----------------------------------------------------------------------------- +! define functions used in the above subroutines + + +!> Returns the value of a sinusoidal bell function + real function spike(x,L) + + real, intent(in) :: x + real, intent(in) :: L + real :: PI = 4.0*atan(1.0) + + spike = 1-sin(PI*min(abs(x)/L, 0.5)) + + end function spike + +!> Returns the value of a cosine-bell function evaluated at x/L + real function cosbell(x,L) + + real , intent(in) :: x !< non-dimensional position + real , intent(in) :: L !< non-dimensional width + real :: PI = 4.0 * atan(1.0) !< 3.1415926... calculated as 4*atan(1) + + cosbell = 0.5 * (1 + cos(PI*MIN(ABS(x/L),1.0))) + end function cosbell + +!< Return the value of a half-cosine-bell function evaluated at x/L; +!< i.e. from peak to trough only on one side of the bell + real function cosbellh(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellh = cos(PI/2.0*MIN(abs(xx)/L, 1.0)) + end function cosbellh + + !< similar to cosbellh but takes a different shape of bell + real function cosbellhnew(x, L, dir) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + real :: PI, xx !< 3.1415926... calculated as 4*atan(1) + real, intent(in) :: dir !< direction flag; 1 for east/north; -1 for west/south + PI = 4.0*atan(1.0) + + !< if the grid falls on the opposite side of the bell, override x to be so big that x/L > 1 + if (x*dir .lt. 0.0) then + xx = L+1 + else + xx = x + endif + + cosbellhnew = 0.5*(1+cos(PI*MIN(xx/L, 1.0))) + end function cosbellhnew + + + !< make sure the depth within L is homogeneous + real function homo(x, L) + + real, intent(in) :: x !< non-dimensional position + real, intent(in) :: L !< non-dimensional width + + !< if x falls within -L ~ L, assign 1 to the non-dimensional depth + if (abs(x) .le. L) then + homo = 1.0 + else + homo = 0.0 + endif + end function homo + +end module channel6_initialization diff --git a/src/user/user_change_diffusivity_Hailu.F90 b/src/user/user_change_diffusivity_Hailu.F90 new file mode 100644 index 0000000000..919574ef13 --- /dev/null +++ b/src/user/user_change_diffusivity_Hailu.F90 @@ -0,0 +1,284 @@ +module user_change_diffusivity_Hailu + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_diag_mediator, only : diag_ctrl, time_type +use MOM_error_handler, only : MOM_error, is_root_pe, FATAL, WARNING, NOTE +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, p3d +use MOM_EOS, only : calculate_density + +implicit none ; private + +#include + +public user_change_diff, user_change_diff_init +public user_change_diff_end + +type, public :: user_change_diff_CS ; private + real :: Kd_add ! The scale of a diffusivity that is added everywhere + ! without any filtering or scaling, in m2 s-1. + real :: lat_range(4) ! 4 values that define the latitude range over which + ! a diffusivity scaled by Kd_add is added, in deg; + ! ascending + real :: rho_range(4) ! 4 values that define the coordinate potential + ! density range over which a diffusivity scaled by + ! Kd_add is added, in kg m-3; ascending + logical :: use_abs_lat ! If true, use the absolute value of latitude when + ! setting lat_range. + type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the + ! timing of diagnostic output. +end type user_change_diff_CS + +contains + +!> This subroutine provides an interface for a user to use to modify the +!! main code to alter the diffusivities as needed. The specific example +!! implemented here augments the diffusivity for a specified range of latitude +!! and coordinate potential density. +!! and a transition of diffusivity between this range and exterior + +subroutine user_change_diff(h, tv, G, CS, Kd, Kd_int, T_f, S_f, Kd_int_add) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness, in m or kg m-2. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers + !! to any available thermodynamic + !! fields. Absent fields have NULL ptrs. + type(user_change_diff_CS), pointer :: CS !< This module's control structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(inout) :: Kd !< The diapycnal diffusivity of + !! each layer in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), optional, intent(inout) :: Kd_int !< The diapycnal diffusivity + !! at each interface in m2 s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: T_f !< Temperature with massless + !! layers filled in vertically. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: S_f !< Salinity with massless + !! layers filled in vertically. + real, dimension(:,:,:), optional, pointer :: Kd_int_add !< The diapycnal + !! diffusivity that is being added at + !! each interface in m2 s-1. + + real :: Rcv(SZI_(G),SZK_(G)) ! The coordinate density in layers in kg m-3. + real :: p_ref(SZI_(G)) ! An array of tv%P_Ref pressures. + real :: rho_fn ! The density dependence of the input function, 0-1, ND. + real :: lat_fn ! The latitude dependence of the input function, 0-1, ND. + logical :: use_EOS ! If true, density is calculated from T & S using an + ! equation of state. + logical :: store_Kd_add ! Save the added diffusivity as a diagnostic if true. + 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 + character(len=200) :: mesg + + 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 + + if (.not.associated(CS)) call MOM_error(FATAL,"user_set_diffusivity: "//& + "Module must be initialized before it is used.") + + use_EOS = associated(tv%eqn_of_state) + if (.not.use_EOS) return ! But what if EOS is not used? + ! e.g. buoyancy/density is used, not salinity or temperature + store_Kd_add = .false. + if (present(Kd_int_add)) store_Kd_add = associated(Kd_int_add) + + if (.not.range_OK(CS%lat_range)) then + write(mesg, '(4(1pe15.6))') CS%lat_range(1:4) + call MOM_error(FATAL, "user_set_diffusivity: bad latitude range: \n "//& + trim(mesg)) + endif + if (.not.range_OK(CS%rho_range)) then + write(mesg, '(4(1pe15.6))') CS%rho_range(1:4) + call MOM_error(FATAL, "user_set_diffusivity: bad density range: \n "//& + trim(mesg)) + endif + + if (store_Kd_add) Kd_int_add(:,:,:) = 0.0 + + do i=is,ie ; p_ref(i) = tv%P_Ref ; enddo + do j=js,je + if (present(T_f) .and. present(S_f)) then + do k=1,nz + call calculate_density(T_f(:,j,k),S_f(:,j,k),p_ref,Rcv(:,k),& + is,ie-is+1,tv%eqn_of_state) + enddo + else + do k=1,nz + call calculate_density(tv%T(:,j,k),tv%S(:,j,k),p_ref,Rcv(:,k),& + is,ie-is+1,tv%eqn_of_state) + enddo + endif + + if (present(Kd)) then + do k=1,nz ; do i=is,ie + if (CS%use_abs_lat) then + lat_fn = val_weights(abs(G%geoLatT(i,j)), CS%lat_range) + else + lat_fn = val_weights(G%geoLatT(i,j), CS%lat_range) + endif + rho_fn = val_weights(Rcv(i,k), CS%rho_range) + if (rho_fn * lat_fn > 0.0) & + Kd(i,j,k) = Kd(i,j,k) + CS%Kd_add * rho_fn * lat_fn + enddo ; enddo + endif + if (present(Kd_int)) then + do K=2,nz ; do i=is,ie + if (CS%use_abs_lat) then + lat_fn = val_weights(abs(G%geoLatT(i,j)), CS%lat_range) + else + lat_fn = val_weights(G%geoLatT(i,j), CS%lat_range) + endif + ! rho_int = 0.5*(Rcv(i,k-1) + Rcv(i,k)) + rho_fn = val_weights( 0.5*(Rcv(i,k-1) + Rcv(i,k)), CS%rho_range) + if (rho_fn * lat_fn > 0.0) then + ! Kd_int is not initialized locally! + Kd_int(i,j,K) = Kd_int(i,j,K) + CS%Kd_add * rho_fn * lat_fn + if (store_Kd_add) Kd_int_add(i,j,K) = CS%Kd_add * rho_fn * lat_fn + endif + enddo ; enddo + endif + enddo + +end subroutine user_change_diff + +!> This subroutine checks whether the 4 values of range are in ascending order. +function range_OK(range) result(OK) + real, dimension(4), intent(in) :: range !< Four values to check. + logical :: OK !< Return value. + + + OK = ((range(1) <= range(2)) .and. (range(2) <= range(3)) .and. & + (range(3) <= range(4))) + +end function range_OK + +!> This subroutine returns a value that goes smoothly from 0 to 1, stays +!! at 1, and then goes smoothly back to 0 at the four values of range. The +!! transitions are cubic, and have zero first derivatives where the curves +!! hit 0 and 1. The values in range must be in ascending order, as can be +!! checked by calling range_OK. +function val_weights(val, range) result(ans) + real, intent(in) :: val !< Value for which we need an answer. + real, dimension(4), intent(in) :: range !< Range over which the answer is non-zero. + real :: ans !< Return value. + + real :: x ! A nondimensional number between 0 and 1. + + ans = 0.0 + if ((val > range(1)) .and. (val < range(4))) then + if (val < range(2)) then + ! x goes from 0 to 1; ans goes from 0 to 1, with 0 derivatives at the ends. + x = (val - range(1)) / (range(2) - range(1)) + ans = x**2 * (3.0 - 2.0 * x) + elseif (val > range(3)) then + ! x goes from 0 to 1; ans goes from 0 to 1, with 0 derivatives at the ends. + x = (range(4) - val) / (range(4) - range(3)) + ans = x**2 * (3.0 - 2.0 * x) + else + ans = 1.0 + endif + endif + +end function val_weights + +!> Set up the module control structure. +subroutine user_change_diff_init(Time, G, param_file, diag, CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating the + !! open file to parse for + !! model parameter values. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(user_change_diff_CS), pointer :: CS !< A pointer that is set to + !! point to the control + !! structure for this module. + +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "user_set_diffusivity" ! This module's name. + character(len=200) :: mesg + integer :: i, j, is, ie, js, je + + if (associated(CS)) then + call MOM_error(WARNING, "diabatic_entrain_init called with an associated "// & + "control structure.") + return + endif + allocate(CS) + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + CS%diag => 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, "USER_KD_ADD", CS%Kd_add, & + "A user-specified additional diffusivity over a range of \n"//& + "latitude and density.", units="m2 s-1", default=0.0) + 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"//& + "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"//& + "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"//& + "checking whether a point fits into range of latitudes.", & + default=.false.) + endif + + if (.not.range_OK(CS%lat_range)) then + write(mesg, '(4(1pe15.6))') CS%lat_range(1:4) + call MOM_error(FATAL, "user_set_diffusivity: bad latitude range: \n "//& + trim(mesg)) + endif + if (.not.range_OK(CS%rho_range)) then + write(mesg, '(4(1pe15.6))') CS%rho_range(1:4) + call MOM_error(FATAL, "user_set_diffusivity: bad density range: \n "//& + trim(mesg)) + endif + +end subroutine user_change_diff_init + +!> Clean up the module control structure. +subroutine user_change_diff_end(CS) + type(user_change_diff_CS), pointer :: CS !< A pointer that is set to + !! point to the control + !! structure for this module. + + if (associated(CS)) deallocate(CS) + +end subroutine user_change_diff_end + +!> \namespace user_change_diffusivity +!! +!! By Robert Hallberg, May 2012 +!! +!! This file contains a subroutine that increments the diapycnal +!! diffusivity in a specified band of latitudes and densities. +!! +!! A small fragment of the grid is shown below: +!! +!! j+1 x ^ x ^ x At x: q +!! j+1 > o > o > At ^: v +!! j x ^ x ^ x At >: u +!! j > o > o > At o: h, T, S, Kd, etc. +!! j-1 x ^ x ^ x +!! i-1 i i+1 At x & ^: +!! i i+1 At > & o: +!! +!! The boundaries always run through q grid points (x). + +end module user_change_diffusivity_Hailu From dd85f85733bfb0611a7e90dc86a5f719ced9039e Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 6 Mar 2018 20:06:31 -0600 Subject: [PATCH 21/26] modified: src/initialization/MOM_fixed_initialization.F90 modified: src/parameterizations/vertical/MOM_vert_friction.F90 modified: src/user/channel4_initialization.F90 modified: src/user/channel6_initialization.F90 --- .../MOM_fixed_initialization.F90 | 3 + .../vertical/MOM_vert_friction.F90 | 73 +++++++++--- src/user/channel4_initialization.F90 | 26 ++-- src/user/channel6_initialization.F90 | 111 ++++++++++++++++-- 4 files changed, 176 insertions(+), 37 deletions(-) diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 7c030bb8d6..cad053fe88 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -41,6 +41,7 @@ module MOM_fixed_initialization use channel3_initialization, only : channel3_initialize_topography use channel4_initialization, only : channel4_initialize_topography use channel5_initialization, only : channel5_initialize_topography +use channel6_initialization, only : channel6_initialize_topography use box_initialization, only : box_initialize_topography use bowlhk_initialization, only : bowlhk_initialize_topography use DOME2d_initialization, only : DOME2d_initialize_topography @@ -216,6 +217,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) " \t channel3 - use the channel3 test case topography. \n"//& " \t channel4 - use the channel4 test case topography. \n"//& " \t channel5 - use the channel5 test case topography. \n"//& + " \t channel6 - use the channel6 test case topography. \n"//& " \t box - use the box test case topography. \n"//& " \t bowlhk - use the bowlhk test case topography. \n"//& " \t DOME - use a slope and channel configuration for the \n"//& @@ -254,6 +256,7 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) case ("channel3"); call channel3_initialize_topography(D, G, PF, max_depth) case ("channel4"); call channel4_initialize_topography(D, G, PF, max_depth) case ("channel5"); call channel5_initialize_topography(D, G, PF, max_depth) + case ("channel6"); call channel6_initialize_topography(D, G, PF, max_depth) case ("box"); call box_initialize_topography(D, G, PF, max_depth) case ("bowlhk"); call bowlhk_initialize_topography(D, G, PF, max_depth) case ("DOME2D"); call DOME2d_initialize_topography(D, G, PF, max_depth) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index fee1fb456a..163809c6ff 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -195,7 +195,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! units of m2 s-1. logical :: do_i(SZIB_(G)) - + real :: ssp = 1.0, xvisc=10. ! width of sponge; extra viscosity to damp sponge velocity integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke @@ -249,10 +249,21 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & surface_stress(I) = dt_Rho0 * (G%mask2dCu(I,j)*forces%taux(I,j)) enddo ; endif ! direct_stress - if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) - enddo ; enddo ; endif - +! if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq +! Ray(I,k) = visc%Ray_u(I,j,k) +! enddo ; enddo ; endif + + if (CS%Channel_drag .AND. & + G%geoLatCu(is,j) 0) ; enddo - if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k) - enddo ; enddo ; endif +! if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq +! Ray(I,k) = visc%Ray_u(I,j,k) +! enddo ; enddo ; endif + + if (CS%Channel_drag .AND. & + G%geoLatCu(is,j) 0) ; enddo - if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie - Ray(i,k) = visc%Ray_v(i,J,k) - enddo ; enddo ; endif +! if (CS%Channel_drag) then ; do k=1,nz ; do i=is,ie +! Ray(i,k) = visc%Ray_v(i,J,k) +! enddo ; enddo ; endif + + if (CS%Channel_drag .AND. & + G%geoLatCv(is,j) +public channel6_initialize_topography public channel6_initialize_sponges ! This include declares and sets the variable "version". @@ -25,16 +26,104 @@ module channel6_initialization contains +! ----------------------------------------------------------------------------- +!> This subroutine sets up the channel6 test case topography. +!> channel6 is similar to channel but: +!> 1) with sloped side walls to mimic continental slope, and to reduce numerical instability +!> 2) the sponge layer has no slope +!> 3) the slope on west/east boundaries decay abruptly to zero at the edge of sponge +!> 4) the shape of Drake Passage in the east is modified so as to match that in the west + +!> update: 1/24/2018: use diagnosed vertical rho profile from sb8sG as sponge layer rho profile +!> update: 3/1/2018: with layer interface height above 0 changed to 0, to kill overflowing + +subroutine channel6_initialize_topography(D, G, param_file, max_depth) + type(dyn_horgrid_type), intent(in) :: G !< The dynamic horizontal grid type + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(out) :: D !< Ocean bottom depth in m + type(param_file_type), intent(in) :: param_file !< Parameter file structure + real, intent(in) :: max_depth !< Maximum depth of model in m + + real :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) + real :: latext, lonext ! latitude extent of the model area + real :: ep = epsilon(1.) ! an infinitesimally small quantity + real :: x, y, sa_dim = 1500.0! dimensional height of Scotia Arc + real :: sa ! the non-dimensional height of Scotia Arc top; + ! default value is 1500/4000=0.375 + real :: dx ! non-dimensional longitudinal grid scale + real :: reentrants, reentrantn ! the non-dimensional latitudes of the southern and northern + ! boundary of the reentrant channel + real :: sdp = 6.0, ll=6.0, ssp = 1.0 ! the width of the slope in Drake Passage, the half width of continental slope, and sponge width + + character(len=40) :: mod = "channel6_initialize_topography" ! This subroutine's name. + integer :: i, j, is, ie, js, je + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + sa = sa_dim / max_depth + latext = G%len_lat + lonext = G%len_lon + reentrants = 6.0/latext ! non-dimensional southern bound of the reentrant zone + reentrantn = 10.0/latext ! non-dimensional northern bound of the reentrant zone + sdp = sdp/latext + ssp = ssp/latext + D = 0.0 + dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/lonext + + call MOM_mesg(" channel6_initialization.F90, channel6_initialize_topography: setting topography", 5) + + call log_version(param_file, mod, version, "") + + + ! Calculate the depth of the bottom. + do j = js,je ! meridional grid points + do i = is,ie ! zonal grid points + x = (G%geoLonT(i,j)-G%west_lon) / lonext ! non-dimensional longitude + y=(G%geoLatT(i,j)-G%south_lat) / latext ! non-dimensional latitude + + D(i,j) = 1.0 - spike(x-dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, west + -spike(x-1.0+dx/2, ll/lonext)*spike(min(0.0, y-reentrantn-sdp/2.0), sdp) & ! Patagonia, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-12.0/latext, 2.5/latext) & ! Patagonia, east, extra slope + -spike(x-dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, west + -spike(x-1.0+dx/2, ll/lonext)*spike(max(0.0, y-reentrants+sdp/2.0), sdp) & ! Antarctic Peninsula, east, original + -sa * spike(x-1.0+dx/2, ll/lonext)*cosbell(y-4.0/latext, 2.5/latext) & ! Antarctic Peninsula, east, extra slope + -spike(y, ll/latext) & ! Antarctica + - sa *cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * homo(y-8.0/latext, 2.0/latext) & !Scotia Arc East, center + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-10.0/latext-ep, 3.0/latext, 1.) & !Scotia Arc East, north slope + - sa * cosbell(x-dx/2-20.0/lonext, 2.5/lonext) * cosbellh(y-6.0/latext+ep, 3.0/latext, -1.) & !Scotia Arc East, south slope + - sa * cosbell(y-12.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc North, east half (slope side) + - sa * cosbell(y-12.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) & !Scotia Arc North, west half + - sa * cosbell(y-4.0/latext, 2.5/latext) * cosbellh(x-dx/2-18.0/lonext-ep, 2.5/lonext, 1.) & !Scotia Arc South, east half (slope side) + - sa * cosbell(y-4.0/latext, 2.5/latext) * homo(x-dx/2-9.0/lonext, 9.0/lonext) !Scotia Arc South, west half + + ! make sure no deeper than max depth and no shallower than Scotia Arc top IN the ocean interior + if (D(i,j)<1.0 - sa .and. x>=dx/1.5+ll/2/lonext .and. x<=1.0-ll/2/lonext-dx/1.5 .and. y>=ll/2/latext .and. y<=1.0-ll/2/latext) then + D(i,j) = 1 - sa + else if (D(i,j) > 1.0) then + D(i,j) = 1.0 + endif + + ! no continental slope in the sponge layer + if (y >= 1.0-ssp) then + D(i,j)=1.0 + endif + + ! make sure the model is not zonally reentrant outside of Drake Passage + if (((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then + D(i,j) = 0.0 + endif + + D(i,j) = D(i,j) * max_depth + enddo + enddo + + +end subroutine channel6_initialize_topography + ! ----------------------------------------------------------------------------- !> 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. -! -! difference from channel 4: -! sponge layer set as 1 deg, to check if the recirculation can be damped -! same: both use diagnosed zonal mean vertical rho profile from sb8sG (without -! adjustment) - subroutine channel6_initialize_sponges(G, GV, use_temperature, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -69,10 +158,9 @@ subroutine channel6_initialize_sponges(G, GV, use_temperature, tv, param_file, C dx = (G%geoLonT(is+1,js)-G%geoLonT(is,js))/G%len_lon ! target interface heights: all negative values - ! corresponds to rho 8 + ! corresponds to rho8a (diagnosed from sb8sG, zonal mean along 30S) - eta0 = (/0.139014429059522, 0.139014429059522, 0.139014429059522, & - 0.138097949711413, -3.03516385164754, -36.3033413229318, & + eta0 = (/ 0., 0., 0., 0., -3.03516385164754, -36.3033413229318, & -74.3258283549342, -129.677962599130, -203.404488662194, & -300.373813497609, -400.174464258654, -488.574700717268, & -567.427597045898, -640.999226537244, -712.274279364224, & @@ -80,10 +168,8 @@ subroutine channel6_initialize_sponges(G, GV, use_temperature, tv, param_file, C -1031.69079589844, -1146.23940724340, -1303.42024809739, & -1550.78595602101, -1854.75769463901, -2146.14440061335, & -2448.03345598493, -2738.49512154715, -3023.71094621931, & - -3311.24889470881, -3622.51995738636, -3921.27119584517, -4000.0 /) + -3311.24889470881, -3622.51995738636, -3921.27119584517, -4000.0 /) - if (first_call) call log_version(param_file, mdl, version) - first_call = .false. call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", units="s-1", & @@ -93,7 +179,6 @@ subroutine channel6_initialize_sponges(G, GV, use_temperature, tv, param_file, C nlat = G%south_lat + G%len_lat ! should be -30.0 degree - ! initialize the damping rate so it is 0 outside of the sponge layer & ! and increases linearly with latitude within the sponge layer From 4bc76830da63b75c7a07e16fa201515da09fe37d Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 6 Mar 2018 21:08:17 -0600 Subject: [PATCH 22/26] modified: src/parameterizations/vertical/MOM_vert_friction.F90 --- .../vertical/MOM_vert_friction.F90 | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 163809c6ff..e3271f5576 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -139,6 +139,7 @@ module MOM_vert_friction subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & taux_bot, tauy_bot) +! type(param_file_type), intent(in) :: param_file !< File to parse for parameters type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, intent(inout), & @@ -193,9 +194,10 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & real :: surface_stress(SZIB_(G))! The same as stress, unless the wind ! stress is applied as a body force, in ! units of m2 s-1. + character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. logical :: do_i(SZIB_(G)) - real :: ssp = 1.0, xvisc=10. ! width of sponge; extra viscosity to damp sponge velocity + real :: ssp = 1.0, xvisc=1.E5 ! width of sponge; extra viscosity to damp sponge velocity integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke @@ -203,6 +205,9 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") +! call get_param(param_file, mdl, "XVISC", xvisc, & +! "extra viscosity to damp velocity in the sponge", default=0.0) + if (CS%direct_stress) then Hmix = CS%Hmix_stress*GV%m_to_H I_Hmix = 1.0 / Hmix @@ -448,6 +453,7 @@ end subroutine vertvisc !! worth of barotropic acceleration that a layer experiences after !! viscosity is applied. subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) +! type(param_file_type), intent(in) :: param_file !< File to parse for parameters type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(vertvisc_type), intent(in) :: visc !< Viscosities and bottom drag @@ -472,7 +478,8 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) real :: dt_m_to_H ! The time step times the conversion from m to the ! units of thickness - either s or s m3 kg-1. logical :: do_i(SZIB_(G)) - real :: ssp = 1.0, xvisc=10.0 ! sponge width; extra viscosity to remove sponge velocity + real :: ssp = 1.0, xvisc=1.E5 ! sponge width; extra viscosity to remove sponge velocity + character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec @@ -481,6 +488,9 @@ subroutine vertvisc_remnant(visc, visc_rem_u, visc_rem_v, dt, G, GV, CS) if (.not.associated(CS)) call MOM_error(FATAL,"MOM_vert_friction(visc): "// & "Module must be initialized before it is used.") +! call get_param(param_file, mdl, "XVISC", xvisc, & +! "extra viscosity to damp velocity in the sponge", default=0.0) + dt_m_to_H = dt*GV%m_to_H do k=1,nz ; do i=Isq,Ieq ; Ray(i,k) = 0.0 ; enddo ; enddo From e80c14bc56783ecad114b082055615e583bd23ea Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Thu, 8 Mar 2018 17:50:28 -0600 Subject: [PATCH 23/26] modified: src/parameterizations/vertical/MOM_vert_friction.F90 --- .../vertical/MOM_vert_friction.F90 | 90 ++++++++++++++----- 1 file changed, 66 insertions(+), 24 deletions(-) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index e3271f5576..5c3f36500d 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -197,7 +197,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. logical :: do_i(SZIB_(G)) - real :: ssp = 1.0, xvisc=1.E5 ! width of sponge; extra viscosity to damp sponge velocity + real :: ssp = 1.0, xvisc=1.E6 ! width of sponge integer :: i, j, k, is, ie, Isq, Ieq, Jsq, Jeq, nz, n is = G%isc ; ie = G%iec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB ; nz = G%ke @@ -257,17 +257,26 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! if (CS%Channel_drag) then ; do k=1,nz ; do I=Isq,Ieq ! Ray(I,k) = visc%Ray_u(I,j,k) ! enddo ; enddo ; endif - + + ! only pass Ray_u to Ray if the grid is in sponge; otherwise Ray = 0 if (CS%Channel_drag .AND. & - G%geoLatCu(is,j)= G%south_lat+G%len_lat-ssp) then ! inside of the sponge do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo - elseif (CS%Channel_drag) then ! inside of the sponge - do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k)+xvisc ! set some spuriously large value - enddo ; enddo endif + +! ! only pass Ray_u to Ray if the grid is in sponge; otherwise Ray = 0 - no extra damping +! if (CS%Channel_drag .AND. & +! G%geoLatCu(is,j) < G%south_lat+G%len_lat-ssp) then ! outside of the sponge +! do k=1,nz ; do I=Isq,Ieq +! Ray(I,k) = visc%Ray_u(I,j,k) +! enddo ; enddo +! elseif (CS%Channel_drag) then ! inside of the sponge +! do k=1,nz ; do I=Isq,Ieq +! Ray(I,k) = visc%Ray_u(I,j,k)+xvisc ! set some spuriously large value +! enddo ; enddo +! endif ! perform forward elimination on the tridiagonal system ! @@ -368,17 +377,34 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, CS, & ! Ray(i,k) = visc%Ray_v(i,J,k) ! enddo ; enddo ; endif - if (CS%Channel_drag .AND. & - G%geoLatCv(is,j)= G%south_lat+G%len_lat-ssp) then ! inside of the sponge +! do k=1,nz ; do I=Isq,Ieq +! Ray(I,k) = visc%Ray_v(I,j,k) +! enddo ; enddo +! endif + + ! only pass Ray_u to Ray if the grid is in sponge; otherwise Ray = 0 + if (CS%Channel_drag .AND. & + G%geoLatCv(is,j) >= G%south_lat+G%len_lat-ssp) then ! inside of the sponge do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_v(I,j,k) enddo ; enddo - elseif (CS%Channel_drag) then ! inside of the sponge - do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_v(I,j,k)+xvisc ! set some spuriously large value - enddo ; enddo endif +! if (CS%Channel_drag .AND. & +! G%geoLatCv(is,j)= G%south_lat+G%len_lat-ssp) then ! inside of the sponge do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_u(I,j,k) enddo ; enddo - elseif (CS%Channel_drag) then ! inside of the sponge - do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_u(I,j,k)+xvisc ! set some spuriously large value - enddo ; enddo endif +! if (CS%Channel_drag .AND. & +! G%geoLatCu(is,j)= G%south_lat+G%len_lat-ssp) then ! inside of the sponge do k=1,nz ; do I=Isq,Ieq Ray(I,k) = visc%Ray_v(I,j,k) enddo ; enddo - elseif (CS%Channel_drag) then ! inside of the sponge - do k=1,nz ; do I=Isq,Ieq - Ray(I,k) = visc%Ray_v(I,j,k)+xvisc ! set some spuriously large value - enddo ; enddo endif +! if (CS%Channel_drag .AND. & +! G%geoLatCv(is,j) Date: Thu, 5 Apr 2018 18:19:52 -0500 Subject: [PATCH 24/26] modified: src/user/channel6_initialization.F90 --- src/user/channel6_initialization.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/user/channel6_initialization.F90 b/src/user/channel6_initialization.F90 index 8c21eed02c..08a350550a 100644 --- a/src/user/channel6_initialization.F90 +++ b/src/user/channel6_initialization.F90 @@ -112,7 +112,7 @@ subroutine channel6_initialize_topography(D, G, param_file, max_depth) .or. ((y>=reentrantn+sdp/2 .or. y<=reentrants-sdp/2) .and. x>1.0-dx/1.5)) then D(i,j) = 0.0 endif - + D(i,j) = D(i,j) * max_depth enddo enddo From 481d92eeb3e382b2755a7f0fcdaabad8757ccbca Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 10 Jul 2018 22:12:42 -0500 Subject: [PATCH 25/26] modified: src/core/MOM.F90 modified: src/parameterizations/lateral/MOM_MEKE.F90 new file: src/parameterizations/lateral/MOM_MEKE_old.F90 --- src/core/MOM.F90 | 1 + src/parameterizations/lateral/MOM_MEKE.F90 | 54 +- .../lateral/MOM_MEKE_old.F90 | 1329 +++++++++++++++++ 3 files changed, 1378 insertions(+), 6 deletions(-) create mode 100644 src/parameterizations/lateral/MOM_MEKE_old.F90 diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 1fd75a71ef..1f39d8b7d0 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -237,6 +237,7 @@ module MOM logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics. logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme. logical :: useMEKE !< If true, call the MEKE parameterization. + !< this has been updated to judge the use of new MEKE logical :: useWaves !< If true, update Stokes drift real :: dtbt_reset_period !< The time interval in seconds between dynamic !! recalculation of the barotropic time step. If diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9ac56b03c6..9cfe8479f8 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1,4 +1,8 @@ !> Implements the Mesoscale Eddy Kinetic Energy framework +!> +!> update from initial MOM_MEKE: included topographic beta effect in computing +!> Rhines scale +!> module MOM_MEKE ! This file is part of MOM6. See LICENSE.md for the license. @@ -573,13 +577,17 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. ! Local variables - real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady + real :: beta, tbf, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady, pi real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr integer :: i, j, is, ie, js, je, n1, n2 real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket in m^2 s^-2. logical :: useSecant, debugIteration + real, dimension(SZI_(G),SZJ_(G)) :: D, lat, lon !< ocean depth, lat & lon at h-points + real :: FatH ! Coriolis parameter at h points; to compute topographic beta + D = G%bathyT; tbf = 1. + lat = G%geolatt; lon = G%geolont is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec debugIteration = .false. @@ -592,7 +600,25 @@ subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) - beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + !beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + ! beta needs to be modified to include topographic beta effect + + 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; interpolated from f at q points + !following MOM_KPP.F90 + + !beta = D(i,j)*sqrt((G%dF_dx(i,j)/D(i,j)-FatH/D(i,j)**2*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2 & + ! +(G%dF_dy(i,j)/D(i,j)-FatH/D(i,j)**2*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2) + + ! revised version of beta* + !beta = sqrt((D(i,j)*G%dF_dx(i,j)-FatH*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2. & + ! +(D(i,j)*G%dF_dy(i,j)-FatH*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2.) + ! new-new beta + beta = sqrt((G%dF_dx(i,j)-FatH/D(i,j)*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2. & + +(G%dF_dy(i,j)-FatH/D(i,j)*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2.) + + I_H = GV%Rho0 * I_mass(i,j) if (KhCoeff*SN*I_H>0.) then @@ -695,11 +721,13 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length (m). ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady - real :: beta, SN + real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady, D, lat, lon + real :: beta, tbf, SN, FatH, re integer :: i, j, is, ie, js, je - + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + D = G%bathyT; lat = G%geolatt; lon = G%geolont + tbf = 1. !$OMP do do j=js,je ; do i=is,ie @@ -709,7 +737,21 @@ subroutine MEKE_lengthScales(CS, MEKE, G, SN_u, SN_v, & else SN = 0. endif - beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + FatH = 0.25*( (G%CoriolisBu(i,j)+G%CoriolisBu(i-1,j-1))+ & + (G%CoriolisBu(i-1,j)+G%CoriolisBu(i,j-1))) + + !beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + ! beta needs to be modified to include topographic beta effect + + !beta = D(i,j)*sqrt((G%dF_dx(i,j)/D(i,j)-FatH/D(i,j)**2*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2 & + ! +(G%dF_dy(i,j)/D(i,j)-FatH/D(i,j)**2*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2) + + !beta = sqrt((D(i,j)*G%dF_dx(i,j)-FatH*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2. & + ! +(D(i,j)*G%dF_dy(i,j)-FatH*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2.) + + beta = sqrt((G%dF_dx(i,j)-FatH/D(i,j)*(D(i+1,j)-D(i-1,j))/2./G%dxT(i,j)/tbf)**2. & + +(G%dF_dy(i,j)-FatH/D(i,j)*(D(i,j+1)-D(i,j-1))/2./G%dyT(i,j)/tbf)**2.) + endif ! Returns bottomFac2, barotrFac2 and LmixScale call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & diff --git a/src/parameterizations/lateral/MOM_MEKE_old.F90 b/src/parameterizations/lateral/MOM_MEKE_old.F90 new file mode 100644 index 0000000000..ce5cbce0da --- /dev/null +++ b/src/parameterizations/lateral/MOM_MEKE_old.F90 @@ -0,0 +1,1329 @@ +!> Implements the Mesoscale Eddy Kinetic Energy framework +module MOM_MEKE_old + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_debugging, only : hchksum, uvchksum +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_ROUTINE +use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr +use MOM_diag_mediator, only : diag_ctrl, time_type +use MOM_domains, only : create_group_pass, do_group_pass +use MOM_domains, only : group_pass_type +use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, MOM_mesg +use MOM_file_parser, only : read_param, get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_hor_index, only : hor_index_type +use MOM_io, only : vardesc, var_desc +use MOM_restart, only : MOM_restart_CS, register_restart_field, query_initialized +use MOM_variables, only : vertvisc_type +use MOM_verticalGrid, only : verticalGrid_type +use MOM_MEKE_types, only : MEKE_type + +implicit none ; private + +#include + +public step_forward_MEKE, MEKE_init, MEKE_alloc_register_restart, MEKE_end + +!> Control structure that contains MEKE parameters and diagnostics handles +type, public :: MEKE_CS ; private + ! Parameters + real :: MEKE_FrCoeff !< Efficiency of conversion of ME into MEKE (non-dim) + real :: MEKE_GMcoeff !< Efficiency of conversion of PE into MEKE (non-dim) + real :: MEKE_damping !< Local depth-independent MEKE dissipation rate in s-1. + real :: MEKE_Cd_scale !< 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. + real :: MEKE_Cb !< Coefficient in the \f$\gamma_{bot}\f$ expression (non-dim) + real :: MEKE_min_gamma!< Minimum value of gamma_b^2 allowed (non-dim) + real :: MEKE_Ct !< Coefficient in the \f$\gamma_{bt}\f$ expression (non-dim) + logical :: visc_drag !< If true use the vertvisc_type to calculate bottom drag. + 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. + 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.) + real :: MEKE_KhCoeff !< Scaling factor to convert MEKE into Kh (non-dim.) + real :: MEKE_Uscale !< MEKE velocity scale for bottom drag (m/s) + real :: MEKE_KH !< Background lateral diffusion of MEKE (m^2/s) + real :: MEKE_K4 !< Background bi-harmonic diffusivity (of MEKE) (m^4/s) + real :: KhMEKE_Fac !< A factor relating MEKE%Kh to the diffusivity used for + !! MEKE itself (nondimensional). + real :: viscosity_coeff !< The scaling coefficient in the expression for + !! viscosity used to parameterize lateral momentum mixing + !! by unresolved eddies represented by MEKE. + real :: Lfixed !< Fixed mixing length scale, in m. + real :: aDeform !< Weighting towards deformation scale of mixing length (non-dim.) + real :: aRhines !< Weighting towards Rhines scale of mixing length (non-dim.) + real :: aFrict !< Weighting towards frictional arrest scale of mixing length (non-dim.) + real :: aEady !< Weighting towards Eady scale of mixing length (non-dim.) + real :: aGrid !< Weighting towards grid scale of mixing length (non-dim.) + real :: MEKE_advection_factor !< A scaling in front of the advection of MEKE (non-dim.) + logical :: initialize !< If True, invokes a steady state solver to calculate MEKE. + logical :: debug !< If true, write out checksums of data for debugging + + ! Optional storage + real, dimension(:,:), allocatable :: del2MEKE ! Laplacian of MEKE, used for bi-harmonic diffusion. + + ! Diagnostic handles + type(diag_ctrl), pointer :: diag !< A pointer to shared diagnostics data + integer :: id_MEKE = -1, id_Ue = -1, id_Kh = -1, id_src = -1 + integer :: id_Ub = -1, id_Ut = -1 + integer :: id_GM_src = -1, id_mom_src = -1, id_decay = -1 + integer :: id_KhMEKE_u = -1, id_KhMEKE_v = -1, id_Ku = -1 + integer :: id_Le = -1, id_gamma_b = -1, id_gamma_t = -1 + integer :: id_Lrhines = -1, id_Leady = -1 + + ! Infrastructure + integer :: id_clock_pass !< Clock for group pass calls + type(group_pass_type) :: pass_MEKE, pass_Kh, pass_Ku, pass_del2MEKE !< Type for group-halo pass calls +end type MEKE_CS + +contains + +!> Integrates forward-in-time the MEKE eddy energy equation. +!! See \ref section_MEKE_equations. +subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, CS, hu, hv) + 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. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thickness in H (m or kg m-2). + 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 u-points (s-1). + type(vertvisc_type), intent(in) :: visc !< The vertical viscosity type. + real, intent(in) :: dt !< Model(baroclinic) time-step (s). + type(MEKE_CS), pointer :: CS !< MEKE control structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: hu !< Zonal flux flux (H m2 s-1). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: hv !< Meridional mass flux (H m2 s-1). + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: & + mass, & ! The total mass of the water column, in kg m-2. + I_mass, & ! The inverse of mass, in m2 kg-1. + src, & ! The sum of all MEKE sources, in m2 s-3. + MEKE_decay, & ! The MEKE decay timescale, in s-1. + MEKE_GM_src, & ! The MEKE source from thickness mixing, in m2 s-3. + MEKE_mom_src, & ! The MEKE source from momentum, in m2 s-3. + drag_rate_visc, & + drag_rate, & ! The MEKE spindown timescale due to bottom drag, in s-1. + LmixScale, & ! Square of eddy mixing length, in m2. + barotrFac2, & ! Ratio of EKE_barotropic / EKE (nondim)/ + bottomFac2 ! Ratio of EKE_bottom / EKE (nondim)/ + real, dimension(SZIB_(G),SZJ_(G)) :: & + MEKE_uflux, & ! The zonal diffusive flux of MEKE, in kg m2 s-3. + Kh_u, & ! The zonal diffusivity that is actually used, in m2 s-1. + baroHu, & ! Depth integrated zonal mass flux (H m2 s-1). + drag_vel_u ! A (vertical) viscosity associated with bottom drag at + ! u-points, in m s-1. + real, dimension(SZI_(G),SZJB_(G)) :: & + MEKE_vflux, & ! The meridional diffusive flux of MEKE, in kg m2 s-3. + Kh_v, & ! The meridional diffusivity that is actually used, in m2 s-1. + baroHv, & ! Depth integrated meridional mass flux (H m2 s-1). + drag_vel_v ! A (vertical) viscosity associated with bottom drag at + ! v-points, in m s-1. + real :: Kh_here, Inv_Kh_max, K4_here + real :: cdrag2 + real :: advFac + real :: mass_neglect ! A negligible mass, in kg m-2. + real :: ldamping ! The MEKE damping rate in s-1. + real :: Rho0 ! A density used to convert mass to distance, in kg m-3. + real :: sdt ! dt to use locally (could be scaled to accelerate) + real :: sdt_damp ! dt for damping (sdt could be split). + logical :: use_drag_rate ! Flag to indicate drag_rate is finite + integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + + if (.not.associated(CS)) call MOM_error(FATAL, & + "MOM_MEKE: Module must be initialized before it is used.") + if (.not.associated(MEKE)) call MOM_error(FATAL, & + "MOM_MEKE: MEKE must be initialized before it is used.") + + Rho0 = GV%H_to_kg_m2 * GV%m_to_H + mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff + sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + if (CS%MEKE_damping + CS%MEKE_Cd_scale > 0.0 .or. CS%MEKE_Cb>0. & + .or. CS%visc_drag) then + use_drag_rate = .true. + else + use_drag_rate = .false. + endif + + ! Only integrate the MEKE equations if MEKE is required. + if (associated(MEKE%MEKE)) then + + if (CS%debug) then + if (associated(MEKE%mom_src)) call hchksum(MEKE%mom_src, 'MEKE mom_src',G%HI) + if (associated(MEKE%GM_src)) call hchksum(MEKE%GM_src, 'MEKE GM_src',G%HI) + if (associated(MEKE%MEKE)) call hchksum(MEKE%MEKE, 'MEKE MEKE',G%HI) + call uvchksum("MEKE SN_[uv]", SN_u, SN_v, G%HI) + call uvchksum("MEKE h[uv]", hu, hv, G%HI, haloshift=1, scale=GV%H_to_m) + endif + + ! Why are these 3 lines repeated from above? + sdt = dt*CS%MEKE_dtScale ! Scaled dt to use for time-stepping + Rho0 = GV%H_to_kg_m2 * GV%m_to_H + mass_neglect = GV%H_to_kg_m2 * GV%H_subroundoff + cdrag2 = CS%cdrag**2 + + ! With a depth-dependent (and possibly strong) damping, it seems + ! advisable to use Strang splitting between the damping and diffusion. + sdt_damp = sdt ; if (CS%MEKE_KH >= 0.0 .or. CS%MEKE_K4 >= 0.) sdt_damp = 0.5*sdt + + ! Calculate depth integrated mass flux if doing advection + if (CS%MEKE_advection_factor>0.) then + do j=js,je ; do I=is-1,ie + baroHu(I,j) = 0. + enddo ; enddo + do k=1,nz + do j=js,je ; do I=is-1,ie + baroHu(I,j) = hu(I,j,k) + enddo ; enddo + enddo + do J=js-1,je ; do i=is,ie + baroHv(i,J) = 0. + enddo ; enddo + do k=1,nz + do J=js-1,je ; do i=is,ie + baroHv(i,J) = hv(i,J,k) + enddo ; enddo + enddo + endif + +!$OMP parallel default(none) shared(MEKE,CS,is,ie,js,je,nz,src,mass,G,GV,h,I_mass, & +!$OMP sdt,drag_vel_u,visc,drag_vel_v,drag_rate_visc, & +!$OMP drag_rate,Rho0,MEKE_decay,sdt_damp,cdrag2, & +!$OMP bottomFac2) & +!$OMP private(ldamping) + + if (CS%MEKE_Cd_scale == 0.0 .and. .not. CS%visc_drag) then +!$OMP do + do j=js,je ; do i=is,ie + drag_rate(i,j) = 0. + enddo ; enddo + endif + + ! Calculate drag_rate_visc(i,j) which accounts for the model bottom mean flow + if (CS%visc_drag) then +!$OMP do + do j=js,je ; do I=is-1,ie + drag_vel_u(I,j) = 0.0 + if ((G%mask2dCu(I,j) > 0.0) .and. (visc%bbl_thick_u(I,j) > 0.0)) & + drag_vel_u(I,j) = visc%kv_bbl_u(I,j) / visc%bbl_thick_u(I,j) + enddo ; enddo +!$OMP do + do J=js-1,je ; do i=is,ie + drag_vel_v(i,J) = 0.0 + if ((G%mask2dCv(i,J) > 0.0) .and. (visc%bbl_thick_v(i,J) > 0.0)) & + drag_vel_v(i,J) = visc%kv_bbl_v(i,J) / visc%bbl_thick_v(i,J) + enddo ; enddo + +!$OMP do + do j=js,je ; do i=is,ie + drag_rate_visc(i,j) = (0.25*G%IareaT(i,j) * & + ((G%areaCu(I-1,j)*drag_vel_u(I-1,j) + & + G%areaCu(I,j)*drag_vel_u(I,j)) + & + (G%areaCv(i,J-1)*drag_vel_v(i,J-1) + & + G%areaCv(i,J)*drag_vel_v(i,J)) ) ) + enddo ; enddo + else +!$OMP do + do j=js,je ; do i=is,ie + drag_rate_visc(i,j) = 0. + enddo ; enddo + endif + +!$OMP do + do j=js-1,je+1 + do i=is-1,ie+1 ; mass(i,j) = 0.0 ; enddo + do k=1,nz ; do i=is-1,ie+1 + mass(i,j) = mass(i,j) + G%mask2dT(i,j) * (GV%H_to_kg_m2 * h(i,j,k)) + enddo ; enddo + do i=is-1,ie+1 + I_mass(i,j) = 0.0 + if (mass(i,j) > 0.0) I_mass(i,j) = 1.0 / mass(i,j) + enddo + enddo +!$OMP end parallel + + if (CS%initialize) then + call MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) + CS%initialize = .false. + endif + + ! Calculates bottomFac2, barotrFac2 and LmixScale + call MEKE_lengthScales(CS, MEKE, G, 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) + call hchksum(drag_rate_visc, 'MEKE drag_rate_visc',G%HI) + call hchksum(bottomFac2, 'MEKE bottomFac2',G%HI) + call hchksum(barotrFac2, 'MEKE barotrFac2',G%HI) + call hchksum(LmixScale, 'MEKE LmixScale',G%HI) + endif + +!$OMP parallel default(none) shared(MEKE,CS,is,ie,js,je,nz,src,mass,G,h,I_mass, & +!$OMP sdt,drag_vel_u,visc,drag_vel_v,drag_rate_visc, & +!$OMP drag_rate,Rho0,MEKE_decay,sdt_damp,cdrag2, & +!$OMP bottomFac2,barotrFac2,use_drag_rate) & +!$OMP private(ldamping) + + ! Aggregate sources of MEKE (background, frictional and GM) +!$OMP do + do j=js,je ; do i=is,ie + src(i,j) = CS%MEKE_BGsrc + enddo ; enddo + + if (associated(MEKE%mom_src)) then +!$OMP do + do j=js,je ; do i=is,ie + src(i,j) = src(i,j) - CS%MEKE_FrCoeff*I_mass(i,j)*MEKE%mom_src(i,j) + enddo ; enddo + endif + + if (associated(MEKE%GM_src)) then +!$OMP do + do j=js,je ; do i=is,ie + src(i,j) = src(i,j) - CS%MEKE_GMcoeff*I_mass(i,j)*MEKE%GM_src(i,j) + enddo ; enddo + endif + + ! Increase EKE by a full time-steps worth of source +!$OMP do + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = (MEKE%MEKE(i,j) + sdt*src(i,j) )*G%mask2dT(i,j) + enddo ; enddo + + if (use_drag_rate) then + ! Calculate a viscous drag rate (includes BBL contributions from mean flow and eddies) +!$OMP do + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + enddo ; enddo + endif + + ! First stage of Strang splitting +!$OMP do + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = ldamping*G%mask2dT(i,j) + enddo ; enddo +!$OMP end parallel + + if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_K4 >= 0.0) then + ! Update halos for lateral or bi-harmonic diffusion + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_MEKE, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + endif + + if (CS%MEKE_K4 >= 0.0) then + ! Calculate Laplacian of MEKE +!$OMP parallel default(none) shared(is,ie,js,je,MEKE_uflux,G,MEKE,MEKE_vflux,CS) +!$OMP do + do j=js,je ; do I=is-1,ie + MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + ! ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & + ! (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) + enddo ; enddo +!$OMP do + do J=js-1,je ; do i=is,ie + MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + ! ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & + ! (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) + enddo ; enddo +!$OMP do + do j=js,je ; do i=is,ie + CS%del2MEKE(i,j) = G%IareaT(i,j) * & + ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) + ! CS%del2MEKE(i,j) = (G%IareaT(i,j)*I_mass(i,j)) * & + ! ((MEKE_uflux(I,j) - MEKE_uflux(I-1,j)) + (MEKE_vflux(i,J) - MEKE_vflux(i,J-1))) + enddo ; enddo +!$OMP end parallel + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_del2MEKE, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + + ! Bi-harmonic diffusion of MEKE +!$OMP parallel default(none) shared(is,ie,js,je,MEKE_uflux,G,CS,sdt,mass, & +!$OMP mass_neglect,MEKE_vflux,I_mass) & +!$OMP private(K4_here,Inv_Kh_max) +!$OMP do + do j=js,je ; do I=is-1,ie + K4_here = CS%MEKE_K4 + ! Limit Kh to avoid CFL violations. + Inv_Kh_max = 64.0*sdt * (((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j),G%IareaT(i+1,j))))**2.0 + if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + + MEKE_uflux(I,j) = ((K4_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & + (CS%del2MEKE(i+1,j) - CS%del2MEKE(i,j)) + enddo ; enddo +!$OMP do + do J=js-1,je ; do i=is,ie + K4_here = CS%MEKE_K4 + Inv_Kh_max = 64.0*sdt * (((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + max(G%IareaT(i,j),G%IareaT(i,j+1))))**2.0 + if (K4_here*Inv_Kh_max > 0.3) K4_here = 0.3 / Inv_Kh_max + + MEKE_vflux(i,J) = ((K4_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & + (CS%del2MEKE(i,j+1) - CS%del2MEKE(i,j)) + enddo ; enddo +!$OMP do + ! Store tendency of bi-harmonic in del2MEKE + do j=js,je ; do i=is,ie + CS%del2MEKE(i,j) = (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & + (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) + enddo ; enddo +!$OMP end parallel + endif ! + +!$OMP parallel default(none) shared(is,ie,js,je,MEKE,CS,sdt,G,Kh_u,MEKE_uflux, & +!$OMP mass,mass_neglect,Kh_v,MEKE_vflux,I_mass, & +!$OMP sdt_damp,drag_rate,Rho0,drag_rate_visc, & +!$OMP cdrag2,bottomFac2,MEKE_decay,barotrFac2, & +!$OMP use_drag_rate,dt,baroHu,baroHv,GV) & +!$OMP private(Kh_here,Inv_Kh_max,ldamping,advFac) + if (CS%MEKE_KH >= 0.0 .or. CS%KhMEKE_FAC > 0.0 .or. CS%MEKE_advection_factor >0.0) then + ! Lateral diffusion of MEKE + Kh_here = max(0.,CS%MEKE_Kh) +!$OMP do + do j=js,je ; do I=is-1,ie + ! Limit Kh to avoid CFL violations. + if (associated(MEKE%Kh)) & + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i+1,j)) + Inv_Kh_max = 2.0*sdt * ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & + max(G%IareaT(i,j),G%IareaT(i+1,j))) + if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max + Kh_u(I,j) = Kh_here + + MEKE_uflux(I,j) = ((Kh_here * (G%dy_Cu(I,j)*G%IdxCu(I,j))) * & + ((2.0*mass(i,j)*mass(i+1,j)) / ((mass(i,j)+mass(i+1,j)) + mass_neglect)) ) * & + (MEKE%MEKE(i,j) - MEKE%MEKE(i+1,j)) + enddo ; enddo +!$OMP do + do J=js-1,je ; do i=is,ie + if (associated(MEKE%Kh)) & + Kh_here = max(0.,CS%MEKE_Kh) + CS%KhMEKE_Fac*0.5*(MEKE%Kh(i,j)+MEKE%Kh(i,j+1)) + Inv_Kh_max = 2.0*sdt * ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & + max(G%IareaT(i,j),G%IareaT(i,j+1))) + if (Kh_here*Inv_Kh_max > 0.25) Kh_here = 0.25 / Inv_Kh_max + Kh_v(i,J) = Kh_here + + MEKE_vflux(i,J) = ((Kh_here * (G%dx_Cv(i,J)*G%IdyCv(i,J))) * & + ((2.0*mass(i,j)*mass(i,j+1)) / ((mass(i,j)+mass(i,j+1)) + mass_neglect)) ) * & + (MEKE%MEKE(i,j) - MEKE%MEKE(i,j+1)) + enddo ; enddo + if (CS%MEKE_advection_factor>0.) then + advFac = GV%H_to_m * CS%MEKE_advection_factor / dt +!$OMP do + do j=js,je ; do I=is-1,ie + if (baroHu(I,j)>0.) then + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i,j)*advFac + elseif (baroHu(I,j)<0.) then + MEKE_uflux(I,j) = MEKE_uflux(I,j) + baroHu(I,j)*MEKE%MEKE(i+1,j)*advFac + endif + enddo ; enddo +!$OMP do + do J=js-1,je ; do i=is,ie + if (baroHv(i,J)>0.) then + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j)*advFac + elseif (baroHv(i,J)<0.) then + MEKE_vflux(i,J) = MEKE_vflux(i,J) + baroHv(i,J)*MEKE%MEKE(i,j+1)*advFac + endif + enddo ; enddo + endif +!$OMP do + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + (sdt*(G%IareaT(i,j)*I_mass(i,j))) * & + ((MEKE_uflux(I-1,j) - MEKE_uflux(I,j)) + & + (MEKE_vflux(i,J-1) - MEKE_vflux(i,J))) + enddo ; enddo + endif ! MEKE_KH>0 + + ! Add on bi-harmonic tendency + if (CS%MEKE_K4 >= 0.0) then +!$OMP do + do j=js,je ; do i=is,ie + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) + CS%del2MEKE(i,j) + enddo ; enddo + endif + + ! Second stage of Strang splitting + if (CS%MEKE_KH >= 0.0 .or. CS%MEKE_K4 >= 0.0) then + if (sdt>sdt_damp) then + ! Recalculate the drag rate, since MEKE has changed. + if (use_drag_rate) then +!$OMP do + do j=js,je ; do i=is,ie + drag_rate(i,j) = (Rho0 * I_mass(i,j)) * sqrt( drag_rate_visc(i,j)**2 & + + cdrag2 * ( max(0.0, 2.0*bottomFac2(i,j)*MEKE%MEKE(i,j)) + CS%MEKE_Uscale**2 ) ) + enddo ; enddo + endif +!$OMP do + do j=js,je ; do i=is,ie + ldamping = CS%MEKE_damping + drag_rate(i,j) * bottomFac2(i,j) + if (MEKE%MEKE(i,j)<0.) ldamping = 0. + ! notice that the above line ensures a damping only if MEKE is positive, + ! while leaving MEKE unchanged if it is negative + MEKE%MEKE(i,j) = MEKE%MEKE(i,j) / (1.0 + sdt_damp*ldamping) + MEKE_decay(i,j) = 0.5 * G%mask2dT(i,j) * (MEKE_decay(i,j) + ldamping) + enddo ; enddo + endif + endif ! MEKE_KH>=0 +!$OMP end parallel + + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_MEKE, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + + ! Calculate diffusivity for main model to use + if (CS%MEKE_KhCoeff>0.) then + if (CS%use_old_lscale) then + if (CS%Rd_as_max_scale) then +!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,CS,G,barotrFac2) + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff & + * sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j))) & + * min(MEKE%Rd_dx_h(i,j), 1.0) + enddo ; enddo + else +!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,CS,G,barotrFac2) + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j))*G%areaT(i,j)) + enddo ; enddo + endif + else +!$OMP parallel do default(none) shared(is,ie,js,je,MEKE,LmixScale,CS,G,barotrFac2) + do j=js,je ; do i=is,ie + MEKE%Kh(i,j) = (CS%MEKE_KhCoeff*sqrt(2.*max(0.,barotrFac2(i,j)*MEKE%MEKE(i,j)))*LmixScale(i,j)) + enddo ; enddo + endif + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_Kh, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + endif + + ! Calculate viscosity for the main model to use + if (CS%viscosity_coeff/=0.) then + do j=js,je ; do i=is,ie + MEKE%Ku(i,j) = CS%viscosity_coeff*sqrt(2.*max(0.,MEKE%MEKE(i,j)))*LmixScale(i,j) + enddo ; enddo + call cpu_clock_begin(CS%id_clock_pass) + call do_group_pass(CS%pass_Ku, G%Domain) + call cpu_clock_end(CS%id_clock_pass) + endif + +! Offer fields for averaging. + if (CS%id_MEKE>0) call post_data(CS%id_MEKE, MEKE%MEKE, CS%diag) + if (CS%id_Ue>0) call post_data(CS%id_Ue, sqrt(max(0.,2.0*MEKE%MEKE)), CS%diag) + if (CS%id_Ub>0) call post_data(CS%id_Ub, sqrt(max(0.,2.0*MEKE%MEKE*bottomFac2)), CS%diag) + if (CS%id_Ut>0) call post_data(CS%id_Ut, sqrt(max(0.,2.0*MEKE%MEKE*barotrFac2)), CS%diag) + if (CS%id_Kh>0) call post_data(CS%id_Kh, MEKE%Kh, CS%diag) + if (CS%id_Ku>0) call post_data(CS%id_Ku, MEKE%Ku, CS%diag) + if (CS%id_KhMEKE_u>0) call post_data(CS%id_KhMEKE_u, Kh_u, CS%diag) + if (CS%id_KhMEKE_v>0) call post_data(CS%id_KhMEKE_v, Kh_v, CS%diag) + if (CS%id_src>0) call post_data(CS%id_src, src, CS%diag) + if (CS%id_decay>0) call post_data(CS%id_decay, MEKE_decay, CS%diag) + if (CS%id_GM_src>0) call post_data(CS%id_GM_src, MEKE%GM_src, CS%diag) + if (CS%id_mom_src>0) call post_data(CS%id_mom_src, MEKE%mom_src, CS%diag) + if (CS%id_Le>0) call post_data(CS%id_Le, LmixScale, CS%diag) + if (CS%id_gamma_b>0) then + do j=js,je ; do i=is,ie + bottomFac2(i,j) = sqrt(bottomFac2(i,j)) + enddo ; enddo + call post_data(CS%id_gamma_b, bottomFac2, CS%diag) + endif + if (CS%id_gamma_t>0) then + do j=js,je ; do i=is,ie + barotrFac2(i,j) = sqrt(barotrFac2(i,j)) + enddo ; enddo + call post_data(CS%id_gamma_t, barotrFac2, CS%diag) + endif + +! else ! if MEKE%MEKE +! call MOM_error(FATAL, "MOM_MEKE: MEKE%MEKE is not associated!") + endif + +end subroutine step_forward_MEKE + +!> Calculates the equilibrium solutino where the source depends only on MEKE diffusivity +!! and there is no lateral diffusion of MEKE. +!! Results is in MEKE%MEKE. +subroutine MEKE_equilibrium(CS, MEKE, G, GV, SN_u, SN_v, drag_rate_visc, I_mass) + type(ocean_grid_type), intent(inout) :: G !< Ocean grid. + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure. + type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_type), pointer :: MEKE !< MEKE data. + 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 u-points (s-1). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: drag_rate_visc !< Mean flow contrib. to drag rate + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: I_mass !< Inverse of column mass. + ! Local variables + real :: beta, SN, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady + real :: I_H, KhCoeff, Kh, Ubg2, cd2, drag_rate, ldamping, src + real :: EKE, EKEmin, EKEmax, resid, ResMin, ResMax, EKEerr + integer :: i, j, is, ie, js, je, n1, n2 + real, parameter :: tolerance = 1.e-12 ! Width of EKE bracket in m^2 s^-2. + logical :: useSecant, debugIteration + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + debugIteration = .false. + KhCoeff = CS%MEKE_KhCoeff + Ubg2 = CS%MEKE_Uscale**2 + cd2 = CS%cdrag**2 + +!$OMP do + do j=js,je ; do i=is,ie + !SN = 0.25*max( (SN_u(I,j) + SN_u(I-1,j)) + (SN_v(i,J) + SN_v(i,J-1)), 0.) + ! This avoids extremes values in equilibrium solution due to bad values in SN_u, SN_v + SN = min( min(SN_u(I,j) , SN_u(I-1,j)) , min(SN_v(i,J), SN_v(i,J-1)) ) + beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + I_H = GV%Rho0 * I_mass(i,j) + + if (KhCoeff*SN*I_H>0.) then + ! Solve resid(E) = 0, where resid = Kh(E) * (SN)^2 - damp_rate(E) E + EKEmin = 0. ! Use the trivial root as the left bracket + ResMin = 0. ! Need to detect direction of left residual + EKEmax = 0.01 ! First guess at right bracket + useSecant = .false. ! Start using a bisection method + + ! First find right bracket for which resid<0 + resid = 1. ; n1 = 0 + do while (resid>0.) + n1 = n1 + 1 + EKE = EKEmax + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, EKE, & + bottomFac2, barotrFac2, LmixScale, & + Lrhines, Leady) + ! TODO: Should include resolution function in Kh + Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale) + src = Kh * (SN * SN) + drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) + ldamping = CS%MEKE_damping + drag_rate * bottomFac2 + resid = src - ldamping * EKE + if (debugIteration) then + write(0,*) n1, 'EKE=',EKE,'resid=',resid + write(0,*) 'EKEmin=',EKEmin,'ResMin=',ResMin + write(0,*) 'src=',src,'ldamping=',ldamping + write(0,*) 'gamma-b=',bottomFac2,'gamma-t=',barotrFac2 + write(0,*) 'drag_visc=',drag_rate_visc(i,j),'Ubg2=',Ubg2 + endif + if (resid>0.) then ! EKE is to the left of the root + EKEmin = EKE ! so we move the left bracket here + EKEmax = 10. * EKE ! and guess again for the right bracket + if (resid 2.e17) then + if (debugIteration) stop 'Something has gone very wrong' + debugIteration = .true. + resid = 1. ; n1 = 0 + EKEmin = 0. ; ResMin = 0. + EKEmax = 0.01 + useSecant = .false. + endif + endif + enddo ! while(resid>0.) searching for right bracket + ResMax = resid + + ! Bisect the bracket + n2 = 0 ; EKEerr = EKEmax - EKEmin + do while (EKEerr>tolerance) + n2 = n2 + 1 + if (useSecant) then + EKE = EKEmin + (EKEmax - EKEmin) * (ResMin / (ResMin - ResMax)) + else + EKE = 0.5 * (EKEmin + EKEmax) + endif + EKEerr = min( EKE-EKEmin, EKEmax-EKE ) + ! TODO: Should include resolution function in Kh + Kh = (KhCoeff * sqrt(2.*barotrFac2*EKE) * LmixScale) + src = Kh * (SN * SN) + drag_rate = I_H * sqrt( drag_rate_visc(i,j)**2 + cd2 * ( 2.0*bottomFac2*EKE + Ubg2 ) ) + ldamping = CS%MEKE_damping + drag_rate * bottomFac2 + resid = src - ldamping * EKE + if (useSecant.and.resid>ResMin) useSecant = .false. + if (resid>0.) then ! EKE is to the left of the root + EKEmin = EKE ! so we move the left bracket here + if (resid EKE is exactly at the root + endif + if (n2>200) stop 'Failing to converge?' + enddo ! while(EKEmax-EKEmin>tolerance) + + else + EKE = 0. + endif + MEKE%MEKE(i,j) = EKE + enddo ; enddo + +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, 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. + 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 u-points (s-1). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: EKE !< Eddy kinetic energy (m2/s2). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: bottomFac2 !< gamma_b^2 + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: barotrFac2 !< gamma_t^2 + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: LmixScale !< Eddy mixing length (m). + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: Lrhines, Leady + real :: beta, SN + integer :: i, j, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + +!$OMP do + 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)) ) + else + SN = 0. + endif + beta = sqrt( G%dF_dx(i,j)**2 + G%dF_dy(i,j)**2 ) + endif + ! Returns bottomFac2, barotrFac2 and LmixScale + call MEKE_lengthScales_0d(CS, G%areaT(i,j), beta, G%bathyT(i,j), & + MEKE%Rd_dx_h(i,j), SN, MEKE%MEKE(i,j), & + bottomFac2(i,j), barotrFac2(i,j), LmixScale(i,j), & + Lrhines(i,j), Leady(i,j)) + enddo ; enddo + if (CS%id_Lrhines>0) call post_data(CS%id_Lrhines, Lrhines, CS%diag) + if (CS%id_Leady>0) call post_data(CS%id_Leady, Leady, CS%diag) + +end subroutine MEKE_lengthScales + +!> 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_0d(CS, area, beta, depth, Rd_dx, SN, & + EKE, bottomFac2, barotrFac2, LmixScale, Lrhines, Leady) + type(MEKE_CS), pointer :: CS !< MEKE control structure. + real, intent(in) :: area !< Grid cell area (m2) + real, intent(in) :: beta !< Planetary beta = |grad F| (s-1 m-1) + real, intent(in) :: depth !< Ocean depth (m) + real, intent(in) :: Rd_dx !< Resolution Ld/dx (nondim). + real, intent(in) :: SN !< Eady growth rate (s-1). + real, intent(in) :: EKE !< Eddy kinetic energy (m s-1). + real, intent(out) :: bottomFac2 !< gamma_b^2 + real, intent(out) :: barotrFac2 !< gamma_t^2 + real, intent(out) :: LmixScale !< Eddy mixing length (m). + real, intent(out) :: Lrhines !< Rhines length scale (m). + real, intent(out) :: Leady !< Eady length scale (m). + ! Local variables + real :: Lgrid, Ldeform, LdeformLim, Ue, Lfrict + + ! Length scale for MEKE derived diffusivity + Lgrid = sqrt(area) ! Grid scale + Ldeform = Lgrid * Rd_dx ! Deformation scale + Lfrict = depth / CS%cdrag ! Frictional arrest scale + ! gamma_b^2 is the ratio of bottom eddy energy to mean column eddy energy + ! used in calculating bottom drag + bottomFac2 = CS%MEKE_CD_SCALE**2 + if (Lfrict*CS%MEKE_Cb>0.) bottomFac2 = bottomFac2 + 1./( 1. + CS%MEKE_Cb*(Ldeform/Lfrict) )**0.8 + bottomFac2 = max(bottomFac2, CS%MEKE_min_gamma) + ! gamma_t^2 is the ratio of barotropic eddy energy to mean column eddy energy + ! used in the velocity scale for diffusivity + barotrFac2 = 1. + if (Lfrict*CS%MEKE_Ct>0.) barotrFac2 = 1./( 1. + CS%MEKE_Ct*(Ldeform/Lfrict) )**0.25 + barotrFac2 = max(barotrFac2, CS%MEKE_min_gamma) + if (CS%use_old_lscale) then + if (CS%Rd_as_max_scale) then + LmixScale = min(Ldeform, Lgrid) ! The smaller of Ld or dx + else + LmixScale = Lgrid + endif + else + Ue = sqrt( 2.0 * max( 0., barotrFac2*EKE ) ) ! Barotropic eddy flow scale + Lrhines = sqrt( Ue / max( beta, 1.e-30 ) ) ! Rhines scale + if (CS%aEady > 0.) then + Leady = Ue / max( SN, 1.e-15 ) ! Bound Eady time-scale < 1e15 seconds + 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 + endif + +end subroutine MEKE_lengthScales_0d + +!> Initializes the MOM_MEKE module and reads parameters. +!! Returns True if module is to be used, otherwise returns False. +logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics structure. + type(MEKE_CS), pointer :: CS !< MEKE control structure. + type(MEKE_type), pointer :: MEKE !< MEKE-related fields. + type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. +! Local variables + integer :: is, ie, js, je, isd, ied, jsd, jed, nz + logical :: laplacian, useVarMix, coldStart +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "MOM_MEKE" ! This module's name. + + 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 + + ! 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"// & + "a sub-grid mesoscale eddy kinetic energy budget.", & + default=.false.) + if (.not. MEKE_init) return + + if (.not. associated(MEKE)) then + ! The MEKE structure should have been allocated in MEKE_alloc_register_restart() + call MOM_error(WARNING, "MEKE_init called with NO associated "// & + "MEKE-type structure.") + return + endif + if (associated(CS)) then + call MOM_error(WARNING, & + "MEKE_init called with an associated control structure.") + return + else ; allocate(CS) ; endif + + call MOM_mesg("MEKE_init: reading parameters ", 5) + + ! 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.", & + 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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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"//& + "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", & + default=0.0) + call get_param(param_file, mdl, "MEKE_KHTR_FAC", MEKE%KhTr_fac, & + "A factor that maps MEKE%Kh to KhTr.", units="nondim", & + default=0.0) + call get_param(param_file, mdl, "MEKE_KHMEKE_FAC", CS%KhMEKE_Fac, & + "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"//& + "a function of grid spacing and deformation radius.", & + 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"//& + "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"//& + "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"//& + "for mixing length used in MEKE-derived diffusiviity.", & + 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.", & + 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.", & + 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.", & + 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.", & + 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.", & + 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"//& + "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"//& + "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"//& + "between the advecting barotropic flow and the vertical structure of MEKE.", & + 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"//& + "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.) + if (CS%viscosity_coeff/=0. .and. .not. laplacian) call MOM_error(FATAL, & + "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF is true.") + + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + + ! Allocation of storage NOT shared with other modules + if (CS%MEKE_K4>=0.) then + allocate(CS%del2MEKE(isd:ied,jsd:jed)) ; CS%del2MEKE(:,:) = 0.0 + endif + +! 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) + call do_group_pass(CS%pass_MEKE, G%Domain) + endif + if (associated(MEKE%Kh)) then + call create_group_pass(CS%pass_Kh, MEKE%Kh, G%Domain) + call do_group_pass(CS%pass_Kh, G%Domain) + endif + if (associated(MEKE%Ku)) then + call create_group_pass(CS%pass_Ku, MEKE%Ku, G%Domain) + call do_group_pass(CS%pass_Ku, G%Domain) + endif + if (allocated(CS%del2MEKE)) then + call create_group_pass(CS%pass_del2MEKE, CS%del2MEKE, G%Domain) + call do_group_pass(CS%pass_del2MEKE, G%Domain) + endif + +! Register fields for output from this module. + CS%diag => diag + CS%id_MEKE = register_diag_field('ocean_model', 'MEKE', diag%axesT1, Time, & + 'Mesoscale Eddy Kinetic Energy', 'm2 s-2') + if (.not. associated(MEKE%MEKE)) CS%id_MEKE = -1 + CS%id_Kh = register_diag_field('ocean_model', 'MEKE_KH', diag%axesT1, Time, & + 'MEKE derived diffusivity', 'm2 s-1') + if (.not. associated(MEKE%Kh)) CS%id_Kh = -1 + CS%id_Ku = register_diag_field('ocean_model', 'MEKE_KU', diag%axesT1, Time, & + 'MEKE derived lateral viscosity', 'm2 s-1') + if (.not. associated(MEKE%Ku)) CS%id_Ku = -1 + CS%id_Ue = register_diag_field('ocean_model', 'MEKE_Ue', diag%axesT1, Time, & + 'MEKE derived eddy-velocity scale', 'm s-1') + if (.not. associated(MEKE%MEKE)) CS%id_Ue = -1 + CS%id_Ub = register_diag_field('ocean_model', 'MEKE_Ub', diag%axesT1, Time, & + 'MEKE derived bottom eddy-velocity scale', 'm s-1') + if (.not. associated(MEKE%MEKE)) CS%id_Ub = -1 + CS%id_Ut = register_diag_field('ocean_model', 'MEKE_Ut', diag%axesT1, Time, & + 'MEKE derived barotropic eddy-velocity scale', 'm s-1') + if (.not. associated(MEKE%MEKE)) CS%id_Ut = -1 + CS%id_src = register_diag_field('ocean_model', 'MEKE_src', diag%axesT1, Time, & + 'MEKE energy source', 'm2 s-3') + 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 + CS%id_mom_src = register_diag_field('ocean_model', 'MEKE_mom_src',diag%axesT1, Time, & + 'MEKE energy available from momentum', 'W m-2') + if (.not. associated(MEKE%mom_src)) CS%id_mom_src = -1 + CS%id_Le = register_diag_field('ocean_model', 'MEKE_Le', diag%axesT1, Time, & + 'Eddy mixing length used in the MEKE derived eddy diffusivity', 'm') + CS%id_Lrhines = register_diag_field('ocean_model', 'MEKE_Lrhines', diag%axesT1, Time, & + 'Rhines length scale used in the MEKE derived eddy diffusivity', 'm') + CS%id_Leady = register_diag_field('ocean_model', 'MEKE_Leady', diag%axesT1, Time, & + 'Eady length scale used in the MEKE derived eddy diffusivity', 'm') + CS%id_gamma_b = register_diag_field('ocean_model', 'MEKE_gamma_b', diag%axesT1, Time, & + 'Ratio of bottom-projected eddy velocity to column-mean eddy velocity', 'nondim') + 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') + + 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 + ! or after a restart. If at the beginning, we will initialize MEKE to a local + ! equilibrium. + CS%initialize = .not.query_initialized(MEKE%MEKE,"MEKE",restart_CS) + if (coldStart) CS%initialize = .false. + if (CS%initialize) call MOM_error(WARNING, & + "MEKE_init: Initializing MEKE with a local equilibrium balance.") + +end function MEKE_init + +!> Allocates memory and register restart fields for the MOM_MEKE module. +subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) +! Arguments + type(hor_index_type), intent(in) :: HI !< Horizontal index structure + type(param_file_type), intent(in) :: param_file !< Parameter file parser structure. + type(MEKE_type), pointer :: MEKE !< A structure with MEKE-related fields. + type(MOM_restart_CS), pointer :: restart_CS !< Restart control structure for MOM_MEKE. +! Local variables + type(vardesc) :: vd + real :: MEKE_GMcoeff, MEKE_FrCoeff, MEKE_KHCoeff, MEKE_viscCoeff + logical :: useMEKE + integer :: isd, ied, jsd, jed + +! Determine whether this module will be used + useMEKE = .false.; call read_param(param_file,"USE_MEKE",useMEKE) + +! Read these parameters to determine what should be in the restarts + MEKE_GMcoeff =-1.; call read_param(param_file,"MEKE_GMCOEFF",MEKE_GMcoeff) + MEKE_FrCoeff =-1.; call read_param(param_file,"MEKE_FRCOEFF",MEKE_FrCoeff) + MEKE_KhCoeff =1.; call read_param(param_file,"MEKE_KHCOEFF",MEKE_KhCoeff) + MEKE_viscCoeff =0.; call read_param(param_file,"MEKE_VISCOSITY_COEFF",MEKE_viscCoeff) + +! Allocate control structure + if (associated(MEKE)) then + call MOM_error(WARNING, "MEKE_alloc_register_restart called with an associated "// & + "MEKE type.") + return + else; allocate(MEKE); endif + + if (.not. useMEKE) return + +! Allocate memory + call MOM_mesg("MEKE_alloc_register_restart: allocating and registering", 5) + isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed + allocate(MEKE%MEKE(isd:ied,jsd:jed)) ; MEKE%MEKE(:,:) = 0.0 + vd = var_desc("MEKE", "m2 s-2", hor_grid='h', z_grid='1', & + longname="Mesoscale Eddy Kinetic Energy") + call register_restart_field(MEKE%MEKE, vd, .false., restart_CS) + if (MEKE_GMcoeff>=0.) then + allocate(MEKE%GM_src(isd:ied,jsd:jed)) ; MEKE%GM_src(:,:) = 0.0 + endif + if (MEKE_FrCoeff>=0.) then + allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 + endif + if (MEKE_KhCoeff>=0.) then + allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 + vd = var_desc("MEKE_Kh", "m2 s-1",hor_grid='h',z_grid='1', & + longname="Lateral diffusivity from Mesoscale Eddy Kinetic Energy") + call register_restart_field(MEKE%Kh, vd, .false., restart_CS) + endif + allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 + if (MEKE_viscCoeff/=0.) then + allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 + vd = var_desc("MEKE_Ah", "m2 s-1", hor_grid='h', z_grid='1', & + longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") + call register_restart_field(MEKE%Ku, vd, .false., restart_CS) + endif + +end subroutine MEKE_alloc_register_restart + +!> Deallocates any variables allocated in MEKE_init or +!! MEKE_alloc_register_restart. +subroutine MEKE_end(MEKE, CS) + type(MEKE_type), pointer :: MEKE !< A structure with MEKE-related fields. + type(MEKE_CS), pointer :: CS !< The control structure for MOM_MEKE. + + if (associated(CS)) deallocate(CS) + + if (.not.associated(MEKE)) return + + if (associated(MEKE%MEKE)) deallocate(MEKE%MEKE) + if (associated(MEKE%GM_src)) deallocate(MEKE%GM_src) + if (associated(MEKE%mom_src)) deallocate(MEKE%mom_src) + if (associated(MEKE%Kh)) deallocate(MEKE%Kh) + if (associated(MEKE%Ku)) deallocate(MEKE%Ku) + if (allocated(CS%del2MEKE)) deallocate(CS%del2MEKE) + deallocate(MEKE) + +end subroutine MEKE_end + +!> \namespace mom_meke +!! +!! \section section_MEKE The Mesoscale Eddy Kinetic Energy (MEKE) framework +!! +!! The MEKE framework accounts for the mean potential energy removed by +!! the first order closures used to parameterize mesoscale eddies. +!! It requires closure at the second order, namely dissipation and transport +!! of eddy energy. +!! +!! Monitoring the sub-grid scale eddy energy budget provides a means to predict +!! a sub-grid eddy-velocity scale which can be used in the lower order closures. +!! +!! \subsection section_MEKE_equations MEKE equations +!! +!! The eddy kinetic energy equation is: +!! \f[ \partial_\tilde{t} E = +!! \overbrace{ \dot{E}_b + \gamma_\eta \dot{E}_\eta + \gamma_v \dot{E}_v +!! }^\text{sources} +!! - \overbrace{ ( \lambda + C_d | U_d | \gamma_b^2 ) E +!! }^\text{local dissipation} +!! + \overbrace{ \nabla \cdot ( ( \kappa_E + \gamma_M \kappa_M ) \nabla E +!! - \kappa_4 \nabla^3 E ) +!! }^\text{smoothing} +!! \f] +!! where \f$ E \f$ is the eddy kinetic energy (variable MEKE) with units of +!! m2s-2, +!! and \f$\tilde{t} = a t\f$ is a scaled time. The non-dimensional factor +!! \f$ a\geq 1 \f$ is used to accelerate towards equilibrium. +!! +!! The MEKE equation is two-dimensional and obtained by depth averaging the +!! the three-dimensional eddy energy equation. In the following expressions +!! \f$ \left< \phi \right> = \frac{1}{H} \int^\eta_{-D} \phi \, dz \f$ maps +!! three dimensional terms into the two-dimensional quantities needed. +!! +!! \subsubsection section_MEKE_source_terms MEKE source terms +!! +!! The source term \f$ \dot{E}_b \f$ is a constant background source +!! of energy intended to avoid the limit \f$E\rightarrow 0\f$. +!! +!! The "GM" source term +!! \f[ \dot{E}_\eta = - \left< \overline{w^\prime b^\prime} \right> +!! = \left< \kappa_h N^2S^2 \right> +!! \approx \left< \kappa_h g\prime |\nabla_\sigma \eta|^2 \right>\f] +!! equals the mean potential energy removed by the Gent-McWilliams closure, +!! and is excluded/included in the MEKE budget by the efficiency parameter +!! \f$ \gamma_\eta \in [0,1] \f$. +!! +!! The "frictional" source term +!! \f[ \dot{E}_{v} = \left< u \cdot \tau_h \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$. +!! +!! \subsubsection section_MEKE_dissipation_terms MEKE dissipation terms +!! +!! The local dissipation of \f$ E \f$ is parameterized through a linear +!! damping, \f$\lambda\f$, and bottom drag, \f$ C_d | U_d | \gamma_b^2 \f$. +!! The \f$ \gamma_b \f$ accounts for the weak projection of the column-mean +!! eddy velocty to the bottom. In other words, the bottom velocity is +!! estimated as \f$ \gamma_b U_e \f$. +!! The bottom drag coefficient, \f$ C_d \f$ is the same as that used in the bottom +!! friction in the mean model equations. +!! +!! The bottom drag velocity scale, \f$ U_d \f$, has contributions from the +!! resolved state and \f$ E \f$: +!! \f[ U_d = \sqrt{ U_b^2 + |u|^2_{z=-D} + |\gamma_b U_e|^2 } .\f] +!! where the eddy velocity scale, \f$ U_e \f$, is given by: +!! \f[ U_e = \sqrt{ 2 E } .\f] +!! \f$ U_b \f$ is a constant background bottom velocity scale and is +!! typically not used (i.e. set to zero). +!! +!! Following Jansen et al., 2015, the projection of eddy energy on to the bottom +!! is given by the ratio of bottom energy to column mean energy: +!! \f[ +!! \gamma_b^2 = \frac{E_b}{E} = \gamma_{d0} +!! + \left( 1 + c_{b} \frac{L_d}{L_f} \right)^{-\frac{4}{5}} +!! , +!! \f] +!! \f[ +!! \gamma_b^2 \leftarrow \max{\left( \gamma_b^2, \gamma_{min}^2 \right)} +!! . +!! \f] +!! +!! \subsection section_MEKE_smoothing MEKE smoothing terms +!! +!! \f$ E \f$ is laterally diffused by a diffusivity \f$ \kappa_E + \gamma_M +!! \kappa_M \f$ where \f$ \kappa_E \f$ is a constant diffusivity and the term +!! \f$ \gamma_M \kappa_M \f$ is a "self diffusion" using the diffusivity +!! calculated in the section \ref section_MEKE_diffusivity. +!! \f$ \kappa_4 \f$ is a constant bi-harmonic diffusivity. +!! +!! \subsection section_MEKE_diffusivity Diffusivity derived from MEKE +!! +!! The predicted eddy velocity scale, \f$ U_e \f$, can be combined with a +!! mixing length scale to form a diffusivity. +!! The primary use of a MEKE derived diffusivity is for use in thickness +!! diffusion (module mom_thickness_diffuse) and optionally in along +!! isopycnal mixing of tracers (module mom_tracer_hor_diff). +!! The original form used (enabled with MEKE_OLD_LSCALE=True): +!! +!! \f[ \kappa_M = \gamma_\kappa \sqrt{ \gamma_t^2 U_e^2 A_\Delta } \f] +!! +!! where \f$ A_\Delta \f$ is the area of the grid cell. +!! Following Jansen et al., 2015, we now use +!! +!! \f[ \kappa_M = \gamma_\kappa l_M \sqrt{ \gamma_t^2 U_e^2 } \f] +!! +!! where \f$ \gamma_\kappa \in [0,1] \f$ is a non-dimensional factor and, +!! following Jansen et al., 2015, \f$\gamma_t^2\f$ is the ratio of barotropic +!! eddy energy to column mean eddy energy given by +!! \f[ +!! \gamma_t^2 = \frac{E_t}{E} = \left( 1 + c_{t} \frac{L_d}{L_f} \right)^{-\frac{1}{4}} +!! , +!! \f] +!! \f[ +!! \gamma_t^2 \leftarrow \max{\left( \gamma_t^2, \gamma_{min}^2 \right)} +!! . +!! \f] +!! +!! The length-scale is a configurable combination of multiple length scales: +!! +!! \f[ +!! l_M = \left( +!! \frac{\alpha_d}{L_d} +!! + \frac{\alpha_f}{L_f} +!! + \frac{\alpha_R}{L_R} +!! + \frac{\alpha_e}{L_e} +!! + \frac{\alpha_\Delta}{L_\Delta} +!! + \frac{\delta[L_c]}{L_c} +!! \right)^{-1} +!! \f] +!! +!! where +!! +!! \f{eqnarray*}{ +!! L_d & = & \sqrt{\frac{c_g^2}{f^2+2\beta c_g}} \sim \frac{ c_g }{f} \\\\ +!! L_R & = & \sqrt{\frac{U_e}{\beta}} \\\\ +!! L_e & = & \frac{U_e}{|S| N} \\\\ +!! L_f & = & \frac{H}{c_d} \\\\ +!! L_\Delta & = & \sqrt{A_\Delta} . +!! \f} +!! +!! \f$L_c\f$ is a constant and \f$\delta[L_c]\f$ is the impulse function so that the term +!! \f$\frac{\delta[L_c]}{L_c}\f$ evaluates to \f$\frac{1}{L_c}\f$ when \f$L_c\f$ is non-zero +!! but is dropped if \f$L_c=0\f$. +!! +!! \subsection section_MEKE_viscosity Viscosity derived from MEKE +!! +!! As for \f$ \kappa_M \f$, the predicted eddy velocity scale can be +!! used to form an eddy viscosity: +!! +!! \f[ \kappa_u = \gamma_u \sqrt{ U_e^2 A_\Delta } . \f] +!! +!! \subsection section_MEKE_limit_case Limit cases for local source-dissipative balance +!! +!! Note that in steady-state (or when \f$ a>>1 \f$) and there is no +!! diffusion of \f$ E \f$ then +!! \f[ \overline{E} \approx \frac{ \dot{E}_b + \gamma_\eta \dot{E}_\eta + +!! \gamma_v \dot{E}_v }{ \lambda + C_d|U_d|\gamma_b^2 } . \f] +!! +!! In the linear drag limit, where +!! \f$ U_e << \min(U_b, |u|_{z=-D}, C_d^{-1}\lambda) \f$, the equilibrium becomes +!! \f$ \overline{E} \approx \frac{ \dot{E}_b + \gamma_\eta \dot{E}_\eta + +!! \gamma_v \dot{E}_v }{ \lambda + C_d \sqrt{ U_b^2 + |u|^2_{z=-D} } } \f$. +!! +!! In the nonlinear drag limit, where \f$ U_e >> \max(U_b, |u|_{z=-D}, C_d^{-1}\lambda) \f$, +!! the equilibrium becomes +!! \f$ \overline{E} \approx \left( \frac{ \dot{E}_b + \gamma_\eta \dot{E}_\eta + +!! \gamma_v \dot{E}_v }{ \sqrt{2} C_d \gamma_b^3 } \right)^\frac{2}{3} \f$. +!! +!! \subsubsection section_MEKE_module_parameters MEKE module parameters +!! +!! | Symbol | Module parameter | +!! | ------ | --------------- | +!! | - | USE_MEKE | +!! | \f$ a \f$ | MEKE_DTSCALE | +!! | \f$ \dot{E}_b \f$ | MEKE_BGSRC | +!! | \f$ \gamma_\eta \f$ | MEKE_GMCOEFF | +!! | \f$ \gamma_v \f$ | MEKE_FrCOEFF | +!! | \f$ \lambda \f$ | MEKE_DAMPING | +!! | \f$ U_b \f$ | MEKE_USCALE | +!! | \f$ \gamma_{d0} \f$ | MEKE_CD_SCALE | +!! | \f$ c_{b} \f$ | MEKE_CB | +!! | \f$ c_{t} \f$ | MEKE_CT | +!! | \f$ \kappa_E \f$ | MEKE_KH | +!! | \f$ \kappa_4 \f$ | MEKE_K4 | +!! | \f$ \gamma_\kappa \f$ | MEKE_KHCOEFF | +!! | \f$ \gamma_M \f$ | MEKE_KHMEKE_FAC | +!! | \f$ \gamma_u \f$ | MEKE_VISCOSITY_COEFF | +!! | \f$ \gamma_{min}^2 \f$| MEKE_MIN_GAMMA2 | +!! | \f$ \alpha_d \f$ | MEKE_ALPHA_DEFORM | +!! | \f$ \alpha_f \f$ | MEKE_ALPHA_FRICT | +!! | \f$ \alpha_R \f$ | MEKE_ALPHA_RHINES | +!! | \f$ \alpha_e \f$ | MEKE_ALPHA_EADY | +!! | \f$ \alpha_\Delta \f$ | MEKE_ALPHA_GRID | +!! | \f$ L_c \f$ | MEKE_FIXED_MIXING_LENGTH | +!! | - | MEKE_KHTH_FAC | +!! | - | MEKE_KHTR_FAC | +!! +!! | Symbol | Model parameter | +!! | ------ | --------------- | +!! | \f$ C_d \f$ | CDRAG | +!! +!! \subsection section_MEKE_references References +!! +!! Jansen, M. F., A. J. Adcroft, R. Hallberg, and I. M. Held, 2015: Parameterization of eddy fluxes based on a mesoscale energy +!! budget. Ocean Modelling, 92, 28--41, http://doi.org/10.1016/j.ocemod.2015.05.007 . +!! +!! Marshall, D. P., and A. J. Adcroft, 2010: Parameterization of ocean eddies: Potential vorticity mixing, energetics and Arnold +!! first stability theorem. Ocean Modelling, 32, 188--204, http://doi.org/10.1016/j.ocemod.2010.02.001 . + +end module MOM_MEKE_old + From 77c2915beaba9cdf3600cc3141e858e2fcac6733 Mon Sep 17 00:00:00 2001 From: Hailu Kong <27735148+hlkong@users.noreply.github.com> Date: Tue, 10 Jul 2018 22:41:52 -0500 Subject: [PATCH 26/26] modified: pkg/CVMix-src --- pkg/CVMix-src | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/pkg/CVMix-src b/pkg/CVMix-src index 534fc38e75..d83f582714 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit 534fc38e759fcb8a2563fa0dc4c0bbf81f758db9 +Subproject commit d83f582714e7f0f98d20efd8fac8fab01fa3bfe6