diff --git a/.github/actions/macos-setup/action.yml b/.github/actions/macos-setup/action.yml index 645a51b619..197a2d83c8 100644 --- a/.github/actions/macos-setup/action.yml +++ b/.github/actions/macos-setup/action.yml @@ -13,5 +13,6 @@ runs: brew update brew install automake brew install netcdf + brew install netcdf-fortran brew install mpich echo "::endgroup::" diff --git a/.testing/Makefile b/.testing/Makefile index 917feb311b..530a552181 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -182,14 +182,25 @@ endif SOURCE = \ $(foreach ext,F90 inc c h,$(wildcard $(1)/*/*.$(ext) $(1)/*/*/*.$(ext))) -MOM_SOURCE = $(call SOURCE,../src) \ - $(wildcard ../config_src/infra/FMS1/*.F90) \ +MOM_SOURCE = \ + $(call SOURCE,../src) \ $(wildcard ../config_src/drivers/solo_driver/*.F90) \ $(wildcard ../config_src/ext*/*/*.F90) -TARGET_SOURCE = $(call SOURCE,build/target_codebase/src) \ - $(wildcard build/target_codebase/config_src/infra/FMS1/*.F90) \ + +TARGET_SOURCE = \ + $(call SOURCE,build/target_codebase/src) \ $(wildcard build/target_codebase/config_src/drivers/solo_driver/*.F90) \ $(wildcard build/target_codebase/config_src/ext*/*.F90) + +# NOTE: Current default framework is FMS1, but this could change. +ifeq ($(FRAMEWORK), fms2) + MOM_SOURCE +=$(wildcard ../config_src/infra/FMS2/*.F90) + TARGET_SOURCE += $(wildcard build/target_codebase/config_src/infra/FMS2/*.F90) +else + MOM_SOURCE += $(wildcard ../config_src/infra/FMS1/*.F90) + TARGET_SOURCE += $(wildcard build/target_codebase/config_src/infra/FMS1/*.F90) +endif + FMS_SOURCE = $(call SOURCE,deps/fms/src) @@ -602,6 +613,7 @@ report.cov: run.cov codecov 2> build/cov/codecov.err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \ || { \ + cat build/cov/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } @@ -740,6 +752,7 @@ report.cov.unit: build/unit/MOM_file_parser_tests.F90.gcov codecov 2> build/unit/codecov.err \ && echo -e "${MAGENTA}Report uploaded to codecov.${RESET}" \ || { \ + cat build/unit/codecov.err ; \ echo -e "${RED}Failed to upload report.${RESET}" ; \ if [ "$(REQUIRE_COVERAGE_UPLOAD)" = true ] ; then false ; fi ; \ } diff --git a/ac/configure.ac b/ac/configure.ac index dc4962307e..8d74d71fbd 100644 --- a/ac/configure.ac +++ b/ac/configure.ac @@ -234,21 +234,28 @@ AC_SUBST([SRC_DIRS], AC_CONFIG_COMMANDS(Makefile.dep, [make depend]) -# setjmp verification +# POSIX verification tests AC_LANG_PUSH([C]) -# Verify that either sigsetjmp (POSIX) or __sigsetjmp (glibc) are available. -AC_CHECK_FUNC([sigsetjmp]) -AS_IF([test "$ac_cv_func_sigsetjmp" == "yes"], [ - SIGSETJMP_NAME="sigsetjmp" -], [ - AC_CHECK_FUNC([__sigsetjmp], [ - SIGSETJMP_NAME="__sigsetjmp" - ], [ - AC_MSG_ERROR([Could not find a symbol for sigsetjmp.]) +# These symbols may be defined as macros, making them inaccessible by Fortran. +# The following exist in BSD and Linux, so we just test for them. +AC_CHECK_FUNC([setjmp], [], [AC_MSG_ERROR([Could not find setjmp.])]) +AC_CHECK_FUNC([longjmp], [], [AC_MSG_ERROR([Could not find longjmp.])]) +AC_CHECK_FUNC([siglongjmp], [], [AC_MSG_ERROR([Could not find siglongjmp.])]) + +# Determine the sigsetjmp symbol. If missing, then point to sigsetjmp_missing. +# +# Supported symbols: +# sigsetjmp POSIX, BSD libc (MacOS) +# __sigsetjmp glibc (Linux) +SIGSETJMP="sigsetjmp_missing" +for sigsetjmp_fn in sigsetjmp __sigsetjmp; do + AC_CHECK_FUNC([${sigsetjmp_fn}], [ + SIGSETJMP=${sigsetjmp_fn} + break ]) -]) -AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["$SIGSETJMP_NAME"]) +done +AC_DEFINE_UNQUOTED([SIGSETJMP_NAME], ["${SIGSETJMP}"]) # Determine the size of jmp_buf and sigjmp_buf AC_CHECK_SIZEOF([jmp_buf], [], [#include ]) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index b6bb14fc01..a12ab35240 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -53,6 +53,7 @@ module ocean_model_mod use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : initialize_ice_shelf_fluxes, initialize_ice_shelf_forces use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: Update_Surface_Waves @@ -274,9 +275,13 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas if (.not.OS%is_ocean_pe) return OS%Time = Time_in ; OS%Time_dyn = Time_in + ! Call initialize MOM with an optional Ice Shelf CS which, if present triggers + ! initialization of ice shelf parameters and arrays. + call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & - diag_ptr=OS%diag, count_calls=.true., waves_CSp=OS%Waves) + diag_ptr=OS%diag, count_calls=.true., ice_shelf_CSp=OS%ice_shelf_CSp, & + waves_CSp=OS%Waves) call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & C_p_scaled=OS%fluxes%C_p, use_temp=use_temperature) @@ -372,9 +377,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas endif if (OS%use_ice_shelf) then - call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & - OS%diag, OS%forces, OS%fluxes) + call initialize_ice_shelf_fluxes(OS%ice_shelf_CSp, OS%grid, OS%US, OS%fluxes) + call initialize_ice_shelf_forces(OS%ice_shelf_CSp, OS%grid, OS%US, OS%forces) endif + if (OS%icebergs_alter_ocean) then call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) if (.not. OS%use_ice_shelf) & diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 10b5f377fa..c1e125be83 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -106,7 +106,7 @@ module MOM_surface_forcing real :: gyres_taux_cos_amp !< The amplitude of cosine wind stress gyres [R L Z T-1 ~> Pa], if WIND_CONFIG=='gyres' real :: gyres_taux_n_pis !< The number of sine lobes in the basin if WIND_CONFIG=='gyres' integer :: answer_date !< This 8-digit integer gives the approximate date with which the order - !! of arithmetic and and expressions were added to the code. + !! of arithmetic and expressions were added to the code. !! Dates before 20190101 use original answers. !! Dates after 20190101 use a form of the gyre wind stresses that are !! rotationally invariant and more likely to be the same between compilers. @@ -161,8 +161,8 @@ module MOM_surface_forcing character(len=200) :: salinityrestore_file = '' !< The file from which to read the sea surface !! salinity to restore toward - character(len=80) :: stress_x_var = '' !< X-windstress variable name in the input file - character(len=80) :: stress_y_var = '' !< Y-windstress variable name in the input file + character(len=80) :: stress_x_var = '' !< X-wind stress variable name in the input file + character(len=80) :: stress_y_var = '' !< Y-wind stress variable name in the input file character(len=80) :: ustar_var = '' !< ustar variable name in the input file character(len=80) :: LW_var = '' !< longwave heat flux variable name in the input file character(len=80) :: SW_var = '' !< shortwave heat flux variable name in the input file @@ -447,6 +447,8 @@ subroutine wind_forcing_2gyre(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = 0.0 enddo ; enddo + if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS) + call callTree_leave("wind_forcing_2gyre") end subroutine wind_forcing_2gyre @@ -484,6 +486,8 @@ subroutine wind_forcing_1gyre(sfc_state, forces, day, G, US, CS) forces%tauy(i,J) = 0.0 enddo ; enddo + if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS) + call callTree_leave("wind_forcing_1gyre") end subroutine wind_forcing_1gyre @@ -499,8 +503,6 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables real :: PI ! A common irrational number, 3.1415926535... [nondim] - real :: I_rho ! The inverse of the reference density times a ratio of scaling - ! factors [Z L-1 R-1 ~> m3 kg-1] real :: y ! The latitude relative to the south normalized by the domain extent [nondim] integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq @@ -530,12 +532,7 @@ subroutine wind_forcing_gyres(sfc_state, forces, day, G, US, CS) forces%taux(i-1,j)*forces%taux(i-1,j) + forces%taux(i,j)*forces%taux(i,j)))/CS%Rho0) ) enddo ; enddo else - I_rho = US%L_to_Z / CS%Rho0 - do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( (CS%gust_const + & - sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & - (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) - enddo ; enddo + call stresses_to_ustar(forces, G, US, CS) endif call callTree_leave("wind_forcing_gyres") @@ -558,8 +555,6 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) real :: Pa_to_RLZ_T2 ! A unit conversion factor from Pa to the internal units ! for wind stresses [R Z L T-2 Pa-1 ~> 1] real :: PI ! A common irrational number, 3.1415926535... [nondim] - real :: I_rho ! The inverse of the reference density times a ratio of scaling - ! factors [Z L-1 R-1 ~> m3 kg-1] real :: y ! The latitude relative to the south normalized by the domain extent [nondim] real :: tau_max ! The magnitude of the wind stress [R Z L T-2 ~> Pa] real :: off ! An offset in the relative latitude [nondim] @@ -602,14 +597,7 @@ subroutine Neverworld_wind_forcing(sfc_state, forces, day, G, US, CS) enddo ; enddo ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. - if (associated(forces%ustar)) then - I_rho = US%L_to_Z / CS%Rho0 - do j=js,je ; do i=is,ie - forces%ustar(i,j) = sqrt( (CS%gust_const + & - sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & - (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) - enddo ; enddo - endif + if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS) end subroutine Neverworld_wind_forcing @@ -625,8 +613,6 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) !! a previous surface_forcing_init call ! Local variables integer :: i, j, kseg - real :: I_rho ! The inverse of the reference density times a ratio of scaling - ! factors [Z L-1 R-1 ~> m3 kg-1] real :: y_curve ! The latitude relative to the southern end of a curve segment [degreesN] real :: L_curve ! The latitudinal extent of a curve segment [degreesN] ! real :: ydata(7) = (/ -70., -45., -15., 0., 15., 45., 70. /) @@ -657,14 +643,7 @@ subroutine scurve_wind_forcing(sfc_state, forces, day, G, US, CS) enddo ; enddo ! Set the surface friction velocity, in units of [Z T-1 ~> m s-1]. ustar is always positive. - if (associated(forces%ustar)) then - I_rho = US%L_to_Z / CS%Rho0 - do j=G%jsc,G%jec ; do i=G%isc,G%iec - forces%ustar(i,j) = sqrt( (CS%gust_const + & - sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & - (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) - enddo ; enddo - endif + if (associated(forces%ustar)) call stresses_to_ustar(forces, G, US, CS) end subroutine scurve_wind_forcing @@ -892,6 +871,37 @@ subroutine wind_forcing_by_data_override(sfc_state, forces, day, G, US, CS) call callTree_leave("wind_forcing_by_data_override") end subroutine wind_forcing_by_data_override +!> Translate the wind stresses into the friction velocity, including effects of background gustiness. +subroutine stresses_to_ustar(forces, G, US, CS) + type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces + type(ocean_grid_type), intent(in) :: G !< Grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(surface_forcing_CS), pointer :: CS !< pointer to control structure returned by + !! a previous surface_forcing_init call + ! Local variables + real :: I_rho ! The inverse of the reference density times a ratio of scaling + ! factors [Z L-1 R-1 ~> m3 kg-1] + integer :: i, j, is, ie, js, je + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + I_rho = US%L_to_Z / CS%Rho0 + + if (CS%read_gust_2d) then + do j=js,je ; do i=is,ie + forces%ustar(i,j) = sqrt( (CS%gust(i,j) + & + sqrt(0.5*((forces%tauy(i,j-1)**2 + forces%tauy(i,j)**2) + & + (forces%taux(i-1,j)**2 + forces%taux(i,j)**2))) ) * I_rho ) + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%ustar(i,j) = sqrt( (CS%gust_const + & + sqrt(0.5*((forces%tauy(i,J-1)**2 + forces%tauy(i,J)**2) + & + (forces%taux(I-1,j)**2 + forces%taux(I,j)**2))) ) * I_rho ) + enddo ; enddo + endif + +end subroutine stresses_to_ustar !> Specifies zero surface buoyancy fluxes from input files. subroutine buoyancy_forcing_from_files(sfc_state, fluxes, day, dt, G, US, CS) diff --git a/config_src/infra/FMS2/MOM_io_infra.F90 b/config_src/infra/FMS2/MOM_io_infra.F90 index c8c55524f8..dc8a9af3d5 100644 --- a/config_src/infra/FMS2/MOM_io_infra.F90 +++ b/config_src/infra/FMS2/MOM_io_infra.F90 @@ -19,7 +19,7 @@ module MOM_io_infra use fms2_io_mod, only : get_global_io_domain_indices use fms_io_utils_mod, only : fms2_file_exist => file_exists -use fms_mod, only : write_version_number, open_namelist_file, check_nml_error +use fms_mod, only : write_version_number, check_nml_error use fms_io_mod, only : file_exist, field_exist, field_size, read_data use fms_io_mod, only : fms_io_exit, get_filename_appendix use mpp_domains_mod, only : mpp_get_compute_domain, mpp_get_global_domain @@ -31,6 +31,8 @@ module MOM_io_infra use mpp_io_mod, only : mpp_get_info, mpp_get_times use mpp_io_mod, only : mpp_io_init use mpp_mod, only : stdout_if_root=>stdout +use mpp_mod, only : mpp_pe, mpp_root_pe, mpp_npes +use mpp_mod, only : mpp_get_current_pelist_name ! These are encoding constants. use mpp_io_mod, only : APPEND_FILE=>MPP_APPEND, WRITEONLY_FILE=>MPP_WRONLY use mpp_io_mod, only : OVERWRITE_FILE=>MPP_OVERWR, READONLY_FILE=>MPP_RDONLY @@ -205,10 +207,20 @@ end subroutine close_file_type !> closes a file. If the unit does not point to an open file, !! close_file_unit simply returns without doing anything. -subroutine close_file_unit(unit) - integer, intent(inout) :: unit !< The I/O unit for the file to be closed - - call mpp_close(unit) +subroutine close_file_unit(iounit) + integer, intent(inout) :: iounit !< The I/O unit for the file to be closed + + logical :: unit_is_open + + ! NOTE: Files opened by `mpp_open` must be closed by `mpp_close`. Otherwise, + ! an error will occur during `fms_io_exit`. + ! + ! Since there is no way to check if `fms_io_init` was called, we are forced + ! to visually confirm that the input unit was not created by `mpp_open`. + ! + ! After `mpp_open` has been removed, this message can be deleted. + inquire(iounit, opened=unit_is_open) + if (unit_is_open) close(iounit) end subroutine close_file_unit !> Ensure that the output stream associated with a file handle is fully sent to disk. @@ -242,10 +254,30 @@ subroutine io_infra_end() end subroutine io_infra_end !> Open a single namelist file that is potentially readable by all PEs. -function MOM_namelist_file(file) result(unit) - character(len=*), optional, intent(in) :: file !< The file to open, by default "input.nml". - integer :: unit !< The opened unit number of the namelist file - unit = open_namelist_file(file) +function MOM_namelist_file(filepath) result(iounit) + character(len=*), optional, intent(in) :: filepath + !< The file to open, by default "input.nml". + integer :: iounit + !< The opened unit number of the namelist file + + character(len=:), allocatable :: nmlpath + ! Namelist path + character(len=:), allocatable :: nmlpath_pe + ! Hypothetical namelist path exclusive to the current PE list + + if (present(filepath)) then + nmlpath = trim(filepath) + else + ! FMS1 first checks for a namelist unique to the PE list, `input_{}.nml`. + ! If not found, it defaults to `input.nml`. + nmlpath_pe = 'input_' // trim(mpp_get_current_pelist_name()) // '.nml' + if (file_exists(nmlpath_pe)) then + nmlpath = nmlpath_pe + else + nmlpath = 'input.nml' + endif + endif + call open_ASCII_file(iounit, nmlpath, action=READONLY_FILE) end function MOM_namelist_file !> Checks the iostat argument that is returned after reading a namelist variable and writes a @@ -403,9 +435,87 @@ subroutine open_ASCII_file(unit, file, action, threading, fileset) !! to threading=MULTIPLE write to the same file (SINGLE_FILE) !! or to one file per PE (MULTIPLE, the default). - call mpp_open(unit, file, action=action, form=ASCII_FILE, threading=threading, fileset=fileset, & - nohdrs=.true.) + integer :: action_flag + integer :: threading_flag + integer :: fileset_flag + logical :: exists + logical :: is_open + character(len=6) :: action_arg, position_arg + character(len=:), allocatable :: filename + + ! NOTE: This function is written to emulate the original behavior of mpp_open + ! from the FMS1 library, on which the MOM API is still based. Much of this + ! can be removed if we choose to drop this compatibility, but for now we + ! try to retain as much as possible. + + ! NOTE: Default FMS1 I/O settings are summarized below. + ! + ! access: Fortran and mpp_open default to SEQUENTIAL. + ! form: The Fortran and mpp_open default (for MPP_ASCII) is FORMATTED. + ! recl: mpp_open uses Fortran defaults when unset, so can be ignored. + ! ios: FMS1 allowed this to be caught, but we do not support it. + ! action/position: In mpp_open, these are inferred from `action`. + ! + ! MOM flag FMS1 flag action position + ! -------- -------- ------ -------- + ! READONLY_FILE MPP_RDONLY READ REWIND + ! WRITEONLY_FILE MPP_WRONLY WRITE REWIND + ! OVERWRITE_FILE MPP_OVERWR WRITE REWIND + ! APPEND_FILE MPP_APPEND WRITE APPEND + ! + ! From this, we can omit `access`, `form`, and `recl`, and can construct + ! `action` and `position` from the input arguments. + + ! I/O configuration + + action_flag = WRITEONLY_FILE + if (present(action)) action_flag = action + + action_arg = 'write' + if (action_flag == READONLY_FILE) action_arg = 'read' + + position_arg = 'rewind' + if (action_flag == APPEND_FILE) position_arg = 'append' + + ! Threading configuration + + threading_flag = SINGLE_FILE + if (present(threading)) threading_flag = threading + + fileset_flag = MULTIPLE + if (present(fileset)) fileset_flag = fileset + + ! Force fileset to be consistent with threading (as in FMS1) + if (threading_flag == SINGLE_FILE) fileset_flag = SINGLE_FILE + + ! Construct the distributed filename, if needed + filename = file + if (fileset_flag == MULTIPLE) then + if (mpp_npes() > 10000) then + write(filename, '(a,".",i6.6)') trim(filename), mpp_pe() - mpp_root_pe() + else + write(filename, '(a,".",i4.4)') trim(filename), mpp_pe() - mpp_root_pe() + endif + endif + + inquire(file=filename, exist=exists) + if (exists .and. action_flag == WRITEONLY_FILE) & + call MOM_error(WARNING, 'open_ASCII_file: File ' // trim(filename) // & + ' opened WRITEONLY already exists!') + + open(newunit=unit, file=filename, action=trim(action_arg), & + position=trim(position_arg)) + + ! This checks if open() failed but did not raise a runtime error. + inquire(unit, opened=is_open) + if (.not. is_open) & + call MOM_error(FATAL, 'open_ASCII_file: File ' // trim(filename) // & + ' failed to open.') + ! NOTE: There are two possible mpp_write_meta functions in FMS1: + ! - call mpp_write_meta( unit, 'filename', cval=mpp_file(unit)%name) + ! - call mpp_write_meta( unit, 'NumFilesInSet', ival=nfiles) + ! I'm not convinced we actually want these, but note them here in case. end subroutine open_ASCII_file diff --git a/docs/equations.rst b/docs/equations.rst index 9d15050927..f90a8f4181 100644 --- a/docs/equations.rst +++ b/docs/equations.rst @@ -6,8 +6,9 @@ hydrostatic primitive equations (either Boussinesq or non-Boussinesq). We present the equations starting from the hydrostatic Boussinesq equation in height coordinates and progress through vector-invariant and -general-coordinate equations to the final equations used in the A.L.E. -algorithm, taken from :cite:`Adcroft2019`. +general-coordinate equations to the final equations used in the +vertical Lagrangian algorithm, taken from +:cite:`Adcroft2019` and :cite:`Griffies_Adcroft_Hallberg2020`. .. toctree:: :maxdepth: 2 diff --git a/docs/images/ALE_general_schematic.png b/docs/images/ALE_general_schematic.png new file mode 100644 index 0000000000..3f492ed56d Binary files /dev/null and b/docs/images/ALE_general_schematic.png differ diff --git a/docs/ocean.bib b/docs/ocean.bib index 2297f25354..ec35116efc 100644 --- a/docs/ocean.bib +++ b/docs/ocean.bib @@ -70,3 +70,63 @@ @article{Kasahara1974 title = {Various Vertical Coordinate Systems Used for Numerical Weather Prediction}, journal = {Monthly Weather Rev.} } + +@Article{Griffies_Adcroft_Hallberg2020, +author = "S.M. Griffies and A. Adcroft and R.W. Hallberg", +title = "A primer on the vertical Lagrangian-remap method in + ocean models based on finite volume generalized vertical coordinates", +journal = "Journal of Advances in Modeling Earth Systems", +year = "2020", +volume = "12", +doi = "10.1029/2019MS001954", +} + +@Article{Shao_etal_2020, +author = "A. Shao and A.J. Adcroft and R.W. Hallberg and S.M. Griffies", +title = "A general-coordinate, nonlocal neutral diffusion operator", +journal = "Journal of Advances in Modeling Earth Systems", +year = "2020", +volume = "12", +doi = "10.1029/2019MS001992", +} + +@Article{GM95, +author = "P. R. Gent and J. Willebrand and T. J. McDougall and J. C. McWilliams", +title = "Parameterizing eddy-induced tracer transports in ocean circulation models", +journal = "Journal of Physical Oceanography", +year = "1995", +volume = "25", +pages = "463--474", +doi = "10.1175/1520-0485(1995)025<0463:PEITTI>2.0.CO;2", +} + +@Article{foxkemper_etal2008, +author = "Baylor Fox-Kemper and Raffaele Ferrari and Robert Hallberg", +title = "Parameterization of mixed layer eddies. {I}: {T}heory and diagnosis", +journal = "Journal of Physical Oceanography", +year = "2008", +volume = "38", +pages = "1145--1165", +doi = "10.1175/2007JPO3792.1", +} + +@Article{McDougall_etal_2021, +author = "T. J. McDougall and P.M.\ Barker and R.M.\ Holmes and R.\ Pawlowicz and S.M.\ Grif\/f\/ies and P.J.\ Durack", +title = "The interpretation of temperature and salinity variables in numerical ocean model output, + and the calculation of heat fluxes and heat content", +journal = "Geoscientific Model Development", +year = "2021", +volume = "14", +pages = "6445--6466", +doi = "10.5194/gmd-14-6445-2021", +} + +@article{Young2010, +author = "W. R. Young", +year = "2010", +title = "Dynamic Enthalpy, {Conservative Temperature}, and the Seawater {Boussinesq} Approximation", +journal = "Journal of Physical Oceanography", +volume = "40", +pages = "394--400", +doi = "10.1175/2009JPO4294.1", +} diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index ca3b9d54de..8116ba3e17 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -10,9 +10,9 @@ module MOM_ALE ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_debugging, only : check_column_integrals, hchksum, uvchksum +use MOM_debugging, only : check_column_integrals use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl -use MOM_diag_mediator, only : time_type, diag_update_remap_grids +use MOM_diag_mediator, only : time_type, diag_update_remap_grids, query_averaging_enabled use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING @@ -123,12 +123,12 @@ module MOM_ALE ! Publicly available functions public ALE_init public ALE_end -public ALE_main -public ALE_main_offline +public ALE_regrid public ALE_offline_inputs -public ALE_offline_tracer_final public ALE_regrid_accelerated public ALE_remap_scalar +public ALE_remap_tracers +public ALE_remap_velocities public ALE_PLM_edge_values public TS_PLM_edge_values public TS_PPM_edge_values @@ -140,6 +140,8 @@ module MOM_ALE public ALE_updateVerticalGridType public ALE_initThicknessToCoord public ALE_update_regrid_weights +public pre_ALE_diagnostics +public pre_ALE_adjustments public ALE_remap_init_conds public ALE_register_diags @@ -164,7 +166,7 @@ subroutine ALE_init( param_file, GV, US, max_depth, CS) ! Local variables character(len=40) :: mdl = "MOM_ALE" ! This module's name. character(len=80) :: string, vel_string ! Temporary strings - real :: filter_shallow_depth, filter_deep_depth + real :: filter_shallow_depth, filter_deep_depth ! Depth ranges of filtering [H ~> m or kg m-2] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. logical :: answers_2018 ! If true, use the order of arithmetic and expressions for remapping @@ -392,11 +394,9 @@ subroutine ALE_end(CS) end subroutine ALE_end -!> Takes care of (1) building a new grid and (2) remapping all variables between -!! the old grid and the new grid. The creation of the new grid can be based -!! on z coordinates, target interface densities, sigma coordinates or any -!! arbitrary coordinate system. -subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) +!> Save any diagnostics of the state before ALE remapping. These diagnostics are +!! mostly used for debugging. +subroutine pre_ALE_diagnostics(G, GV, US, h, u, v, tv, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -405,23 +405,11 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure - type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, optional, intent(in) :: dt !< Time step between calls to ALE_main [T ~> s] - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice shelf coverage [nondim] - ! Local variables - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta_preale - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] - logical :: PCM_cell(SZI_(G),SZJ_(G),SZK_(GV)) !< If true, PCM remapping should be used in a cell. - integer :: ntr, i, j, k, isc, iec, jsc, jec, nk - - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke - if (CS%show_call_tree) call callTree_enter("ALE_main(), MOM_ALE.F90") + ! Local variables + real :: eta_preale(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Interface heights before remapping [Z ~> m] - ! These diagnostics of the state before ALE is applied are mostly used for debugging. if (CS%id_u_preale > 0) call post_data(CS%id_u_preale, u, CS%diag) if (CS%id_v_preale > 0) call post_data(CS%id_v_preale, v, CS%diag) if (CS%id_h_preale > 0) call post_data(CS%id_h_preale, h, CS%diag) @@ -432,121 +420,77 @@ subroutine ALE_main( G, GV, US, h, u, v, tv, Reg, CS, OBC, dt, frac_shelf_h) call post_data(CS%id_e_preale, eta_preale, CS%diag) endif - if (present(dt)) then - call ALE_update_regrid_weights( dt, CS ) - endif - dzRegrid(:,:,:) = 0.0 - - ! If necessary, do some preparatory work to clean up the model state before regridding. +end subroutine pre_ALE_diagnostics - ! This adjusts the input thicknesses prior to remapping, based on the verical coordinate. - if (CS%do_conv_adj) call convective_adjustment(G, GV, h, tv) - if (CS%use_hybgen_unmix) then - ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr - call hybgen_unmix(G, GV, G%US, CS%hybgen_unmixCS, tv, Reg, ntr, h) - endif - ! Build new grid. The new grid is stored in h_new. The old grid is h. - ! Both are needed for the subsequent remapping of variables. - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust=.false., & - frac_shelf_h=frac_shelf_h, PCM_cell=PCM_cell) - - call check_grid( G, GV, h, 0. ) - - if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_main)") - - ! The presence of dt is used for expediency to distinguish whether ALE_main is being called during init - ! or in the main loop. Tendency diagnostics in remap_all_state_vars also rely on this logic. - if (present(dt)) then - call diag_update_remap_grids(CS%diag) - endif - - ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, dzRegrid, u, v, & - CS%show_call_tree, dt, PCM_cell=PCM_cell ) - - if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") - - ! Override old grid with new one. The new grid 'h_new' is built in - ! one of the 'build_...' routines above. - !$OMP parallel do default(shared) - do k=1,nk ; do j=jsc-1,jec+1 ; do i=isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo - - if (CS%debug) then - call hchksum(h, "Post-ALE_main h", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(tv%T, "Post-ALE_main T", G%HI, haloshift=0, scale=US%C_to_degC) - call hchksum(tv%S, "Post-ALE_main S", G%HI, haloshift=0, scale=US%S_to_ppt) - call uvchksum("Post-ALE_main [uv]", u, v, G%HI, haloshift=0, scale=US%L_T_to_m_s) - endif - - if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) - - if (CS%show_call_tree) call callTree_leave("ALE_main()") - -end subroutine ALE_main - -!> Takes care of (1) building a new grid and (2) remapping all variables between -!! the old grid and the new grid. The creation of the new grid can be based -!! on z coordinates, target interface densities, sigma coordinates or any -!! arbitrary coordinate system. -subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, OBC, dt) +!> Potentially do some preparatory work, such as convective adjustment, to clean up the model +!! state before regridding. +subroutine pre_ALE_adjustments(G, GV, US, h, tv, Reg, CS, u, v) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the !! last time step [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, optional, intent(in) :: dt !< Time step between calls to ALE_main [T ~> s] - ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_new ! New 3D grid obtained after last time step [H ~> m or kg m-2] - integer :: ntr, i, j, k, isc, iec, jsc, jec, nk - - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke - - if (CS%show_call_tree) call callTree_enter("ALE_main_offline(), MOM_ALE.F90") + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + optional, intent(inout) :: u !< Zonal velocity field [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + optional, intent(inout) :: v !< Meridional velocity field [L T-1 ~> m s-1] - if (present(dt)) then - call ALE_update_regrid_weights( dt, CS ) - endif - dzRegrid(:,:,:) = 0.0 + integer :: ntr - ! This adjusts the input state prior to remapping, depending on the verical coordinate. + ! Do column-wise convective adjustment. + ! Tracers and velocities should probably also undergo consistent adjustments. if (CS%do_conv_adj) call convective_adjustment(G, GV, h, tv) + if (CS%use_hybgen_unmix) then ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr - call hybgen_unmix(G, GV, G%US, CS%hybgen_unmixCS, tv, Reg, ntr, h) + call hybgen_unmix(G, GV, US, CS%hybgen_unmixCS, tv, Reg, ntr, h) endif - ! Build new grid. The new grid is stored in h_new. The old grid is h. - ! Both are needed for the subsequent remapping of variables. - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust=.false. ) +end subroutine pre_ALE_adjustments - call check_grid( G, GV, h, 0. ) +!> Takes care of building a new grid. The creation of the new grid can be based on z coordinates, +!! target interface densities, sigma coordinates or any arbitrary coordinate system. +subroutine ALE_regrid( G, GV, US, h, h_new, dzRegrid, tv, CS, frac_shelf_h, PCM_cell) + type(ocean_grid_type), intent(in) :: G !< Ocean grid informations + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses in 3D grid before + !! regridding [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h_new !< Layer thicknesses in 3D grid after + !! regridding [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: dzRegrid !< The change in grid interface positions + !! due to regridding, in the same units as + !! thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure + type(ALE_CS), pointer :: CS !< Regridding parameters and options + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: frac_shelf_h !< Fractional ice shelf coverage [nondim] + logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + optional, intent(out) :: PCM_cell !< If true, use PCM remapping in a cell. - if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_main)") + ! Local variables + logical :: showCallTree - ! Remap all variables from old grid h onto new grid h_new + showCallTree = callTree_showQuery() - call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree, dt=dt ) + if (showCallTree) call callTree_enter("ALE_regrid(), MOM_ALE.F90") - if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_main)") + ! Build the new grid and store it in h_new. The old grid is retained as h. + ! Both are needed for the subsequent remapping of variables. + dzRegrid(:,:,:) = 0.0 + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, & + frac_shelf_h=frac_shelf_h, PCM_cell=PCM_cell) - ! Override old grid with new one. The new grid 'h_new' is built in - ! one of the 'build_...' routines above. - !$OMP parallel do default(shared) - do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) - enddo ; enddo ; enddo + if (CS%id_dzRegrid>0) then ; if (query_averaging_enabled(CS%diag)) then + call post_data(CS%id_dzRegrid, dzRegrid, CS%diag, alt_h=h_new) + endif ; endif - if (CS%show_call_tree) call callTree_leave("ALE_main()") - if (CS%id_dzRegrid>0 .and. present(dt)) call post_data(CS%id_dzRegrid, dzRegrid, CS%diag) + if (showCallTree) call callTree_leave("ALE_regrid()") -end subroutine ALE_main_offline +end subroutine ALE_regrid !> Regrid/remap stored fields used for offline tracer integrations. These input fields are assumed to have !! the same layer thicknesses at the end of the last offline interval (which should be a Zstar grid). This @@ -560,15 +504,15 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) type(tracer_registry_type), pointer :: Reg !< Tracer registry structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes [H L2 ~> m3 or kg] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes [H L2 ~> m3 or kg] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites [Z2 T-1 ~> m2 s-1] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivities [Z2 T-1 ~> m2 s-1] logical, intent(in ) :: debug !< If true, then turn checksums type(ocean_OBC_type), pointer :: OBC !< Open boundary structure ! Local variables integer :: nk, i, j, k, isc, iec, jsc, jec real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: h_src ! Source grid thicknesses at velocity points [H ~> m or kg m-2] - real, dimension(SZK_(GV)) :: h_dest ! Destination grid thicknesses at velocity points [H ~> m or kg m-2] + real, dimension(SZK_(GV)) :: h_dest ! Destination grid thicknesses at velocity points [H ~> m or kg m-2] real, dimension(SZK_(GV)) :: temp_vec ! Transports on the destination grid [H L2 ~> m3 or kg] isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke @@ -580,12 +524,11 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) ! Build new grid from the Zstar state onto the requested vertical coordinate. The new grid is stored ! in h_new. The old grid is h. Both are needed for the subsequent remapping of variables. Convective ! adjustment right now is not used because it is unclear what to do with vanished layers - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust=.false. ) - call check_grid( G, GV, h_new, 0. ) + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid) if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_offline_inputs)") ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) + call ALE_remap_tracers(CS, G, GV, h, h_new, Reg, debug=CS%show_call_tree) if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_inputs)") ! Reintegrate mass transports from Zstar to the offline vertical coordinate @@ -622,93 +565,13 @@ subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug, OBC) ! Copy over the new layer thicknesses do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) + h(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo if (CS%show_call_tree) call callTree_leave("ALE_offline_inputs()") end subroutine ALE_offline_inputs -!> Remaps all tracers from h onto h_target. This is intended to be called when tracers -!! are done offline. In the case where transports don't quite conserve, we still want to -!! make sure that layer thicknesses offline do not drift too far away from the online model -subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS, OBC) - type(ocean_grid_type), intent(in) :: G !< Ocean grid informations - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after - !! last time step [H ~> m or kg m-2] - type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - type(ALE_CS), pointer :: CS !< Regridding parameters and options - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - ! Local variables - - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid !< The change in grid interface positions - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new !< Regridded target thicknesses - integer :: ntr, i, j, k, isc, iec, jsc, jec, nk - - isc = G%isc ; iec = G%iec ; jsc = G%jsc ; jec = G%jec ; nk = GV%ke - - if (CS%show_call_tree) call callTree_enter("ALE_offline_tracer_final(), MOM_ALE.F90") - ! Need to make sure that h_target is consistent with the current offline ALE confiuration - if (CS%do_conv_adj) call convective_adjustment(G, GV, h_target, tv) - if (CS%use_hybgen_unmix) then - ntr = 0 ; if (associated(Reg)) ntr = Reg%ntr - call hybgen_unmix(G, GV, G%US, CS%hybgen_unmixCS, tv, Reg, ntr, h) - endif - call regridding_main( CS%remapCS, CS%regridCS, G, GV, h_target, tv, h_new, dzRegrid, conv_adjust=.false. ) - call check_grid( G, GV, h_target, 0. ) - - - if (CS%show_call_tree) call callTree_waypoint("Source and target grids checked (ALE_offline_tracer_final)") - - ! Remap all variables from old grid h onto new grid h_new - - call remap_all_state_vars( CS, G, GV, h, h_new, Reg, OBC, debug=CS%show_call_tree ) - - if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_offline_tracer_final)") - - ! Override old grid with new one. The new grid 'h_new' is built in - ! one of the 'build_...' routines above. - !$OMP parallel do default(shared) - do k = 1,nk - do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_new(i,j,k) - enddo ; enddo - enddo - if (CS%show_call_tree) call callTree_leave("ALE_offline_tracer_final()") -end subroutine ALE_offline_tracer_final - -!> Check grid for negative thicknesses -subroutine check_grid( G, GV, h, threshold ) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Current 3D grid obtained after the - !! last time step [H ~> m or kg m-2] - real, intent(in) :: threshold !< Value below which to flag issues, - !! [H ~> m or kg m-2] - ! Local variables - integer :: i, j - - do j = G%jsc,G%jec ; do i = G%isc,G%iec - if (G%mask2dT(i,j)>0.) then - if (minval(h(i,j,:)) < threshold) then - write(0,*) 'check_grid: i,j=',i,j,'h(i,j,:)=',h(i,j,:) - if (threshold <= 0.) then - call MOM_error(FATAL,"MOM_ALE, check_grid: negative thickness encountered.") - else - call MOM_error(FATAL,"MOM_ALE, check_grid: too tiny thickness encountered.") - endif - endif - endif - enddo ; enddo - - -end subroutine check_grid - - !> For a state-based coordinate, accelerate the process of regridding by !! repeatedly applying the grid calculation algorithm subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, dzRegrid, initial) @@ -728,7 +591,7 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d optional, pointer :: Reg !< Tracer registry to remap onto new grid real, optional, intent(in) :: dt !< Model timestep to provide a timescale for regridding [T ~> s] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(inout) :: dzRegrid !< Final change in interface positions + optional, intent(inout) :: dzRegrid !< Final change in interface positions [H ~> m or kg m-2] logical, optional, intent(in) :: initial !< Whether we're being called from an initialization !! routine (and expect diagnostics to work) @@ -736,11 +599,15 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d integer :: i, j, itt, nz type(thermo_var_ptrs) :: tv_local ! local/intermediate temp/salt type(group_pass_type) :: pass_T_S_h ! group pass if the coordinate has a stencil - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_loc, h_orig ! A working copy of layer thicknesses - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: T, S ! local temporary state + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_loc ! A working copy of layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_orig ! The original layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: T ! local temporary temperatures [C ~> degC] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: S ! local temporary salinities [S ~> ppt] ! we have to keep track of the total dzInterface if for some reason ! we're using the old remapping algorithm for u/v - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzInterface, dzIntTotal + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzInterface ! Interface height changes within + ! an iteration [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: dzIntTotal ! Cumulative interface position changes [H ~> m or kg m-2] real :: h_neglect, h_neglect_edge ! small thicknesses [H ~> m or kg m-2] nz = GV%ke @@ -775,14 +642,14 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d h_neglect = GV%kg_m2_to_H * 1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H * 1.0e-10 endif - do itt = 1, n_itt call do_group_pass(pass_T_S_h, G%domain) ! generate new grid if (CS%do_conv_adj) call convective_adjustment(G, GV, h_loc, tv_local) - call regridding_main(CS%remapCS, CS%regridCS, G, GV, h_loc, tv_local, h, dzInterface, conv_adjust=.false.) + + call regridding_main(CS%remapCS, CS%regridCS, G, GV, h_loc, tv_local, h, dzInterface) dzIntTotal(:,:,:) = dzIntTotal(:,:,:) + dzInterface(:,:,:) ! remap from original grid onto new grid @@ -798,20 +665,18 @@ subroutine ALE_regrid_accelerated(CS, G, GV, h, tv, n_itt, u, v, OBC, Reg, dt, d enddo ! remap all state variables (including those that weren't needed for regridding) - call remap_all_state_vars(CS, G, GV, h_orig, h, Reg, OBC, dzIntTotal, u, v) + call ALE_remap_tracers(CS, G, GV, h_orig, h, Reg) + call ALE_remap_velocities(CS, G, GV, h_orig, h, u, v, OBC, dzIntTotal) ! save total dzregrid for diags if needed? if (present(dzRegrid)) dzRegrid(:,:,:) = dzIntTotal(:,:,:) end subroutine ALE_regrid_accelerated -!> This routine takes care of remapping all variable between the old and the -!! new grids. When velocity components need to be remapped, thicknesses at -!! velocity points are taken to be arithmetic averages of tracer thicknesses. -!! This routine is called during initialization of the model at time=0, to +!> This routine takes care of remapping all tracer variables between the old and the +!! new grids. This routine is called during initialization of the model at time=0, to !! remap initial conditions to the model grid. It is also called during a !! time step to update the state. -subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & - dzInterface, u, v, debug, dt, PCM_cell) +subroutine ALE_remap_tracers(CS, G, GV, h_old, h_new, Reg, debug, dt, PCM_cell) type(ALE_CS), intent(in) :: CS !< ALE control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -820,25 +685,13 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid !! [H ~> m or kg m-2] type(tracer_registry_type), pointer :: Reg !< Tracer registry structure - type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & - optional, intent(in) :: dzInterface !< Change in interface position - !! [H ~> m or kg m-2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & - optional, intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & - optional, intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] logical, optional, intent(in) :: debug !< If true, show the call tree real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: PCM_cell !< Use PCM remapping in cells where true ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! The vertically summed thicknesses [H ~> m or kg m-2] - real :: h_mask_vel ! A depth below which the thicknesses at a velocity point are masked out [H ~> m or kg m-2] - real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to - ! a velocity point [H ~> m or kg m-2] - real :: tr_column(GV%ke) ! A column of updated tracer concentrations + real :: tr_column(GV%ke) ! A column of updated tracer concentrations [CU ~> Conc] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_conc ! The rate of change of concentrations [Conc T-1 ~> Conc s-1] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: work_cont ! The rate of change of cell-integrated tracer ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] or @@ -847,10 +700,6 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & ! content [Conc H T-1 ~> Conc m s-1 or Conc kg m-2 s-1] logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell. real :: Idt ! The inverse of the timestep [T-1 ~> s-1] - real :: u_src(GV%ke) ! A column of u-velocities on the source grid [L T-1 ~> m s-1] - real :: u_tgt(GV%ke) ! A column of u-velocities on the target grid [L T-1 ~> m s-1] - real :: v_src(GV%ke) ! A column of v-velocities on the source grid [L T-1 ~> m s-1] - real :: v_tgt(GV%ke) ! A column of v-velocities on the target grid [L T-1 ~> m s-1] real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] @@ -861,13 +710,6 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & show_call_tree = .false. if (present(debug)) show_call_tree = debug - ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, - ! u and v can be remapped without dzInterface - if ( .not. present(dzInterface) .and. (CS%remap_uv_using_old_alg .and. (present(u) .or. present(v))) ) then - call MOM_error(FATAL, "remap_all_state_vars: dzInterface must be present if using old algorithm "// & - "and u/v are to be remapped") - endif - if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff elseif (GV%Boussinesq) then @@ -876,7 +718,7 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 endif - if (show_call_tree) call callTree_enter("remap_all_state_vars(), MOM_ALE.F90") + if (show_call_tree) call callTree_enter("ALE_remap_tracers(), MOM_ALE.F90") nz = GV%ke @@ -890,7 +732,7 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & ! Remap all registered tracers, including temperature and salinity. if (ntr>0) then - if (show_call_tree) call callTree_waypoint("remapping tracers (remap_all_state_vars)") + if (show_call_tree) call callTree_waypoint("remapping tracers (ALE_remap_tracers)") !$OMP parallel do default(shared) private(h1,h2,tr_column,Tr,PCM,work_conc,work_cont,work_2d) do m=1,ntr ! For each tracer Tr => Reg%Tr(m) @@ -938,6 +780,7 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & if (Tr%id_remap_cont > 0) then call post_data(Tr%id_remap_cont, work_cont, CS%diag) endif + if (Tr%id_remap_cont_2d > 0) then do j = G%jsc,G%jec ; do i = G%isc,G%iec work_2d(i,j) = 0.0 @@ -952,9 +795,79 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ! endif for ntr > 0 - if (show_call_tree) call callTree_waypoint("tracers remapped (remap_all_state_vars)") - if (CS%partial_cell_vel_remap .and. (present(u) .or. present(v)) ) then + if (CS%id_vert_remap_h > 0) call post_data(CS%id_vert_remap_h, h_old, CS%diag) + if ((CS%id_vert_remap_h_tendency > 0) .and. present(dt)) then + do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec + work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt + enddo ; enddo ; enddo + call post_data(CS%id_vert_remap_h_tendency, work_cont, CS%diag) + endif + + if (show_call_tree) call callTree_leave("ALE_remap_tracers(), MOM_ALE.F90") + +end subroutine ALE_remap_tracers + +!> This routine remaps velocity components between the old and the new grids, +!! with thicknesses at velocity points taken to be arithmetic averages of tracer thicknesses. +!! This routine may be called during initialization of the model at time=0, to +!! remap initial conditions to the model grid. It is also called during a +!! time step to update the state. +subroutine ALE_remap_velocities(CS, G, GV, h_old, h_new, u, v, OBC, dzInterface, debug, dt) + type(ALE_CS), intent(in) :: CS !< ALE control structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Thickness of source grid + !! [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_new !< Thickness of destination grid + !! [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: u !< Zonal velocity [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & + intent(inout) :: v !< Meridional velocity [L T-1 ~> m s-1] + type(ocean_OBC_type), pointer :: OBC !< Open boundary structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), & + optional, intent(in) :: dzInterface !< Change in interface position + !! [H ~> m or kg m-2] + logical, optional, intent(in) :: debug !< If true, show the call tree + real, optional, intent(in) :: dt !< time step for diagnostics [T ~> s] + + ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: h_tot ! The vertically summed thicknesses [H ~> m or kg m-2] + real :: h_mask_vel ! A depth below which the thicknesses at a velocity point are masked out [H ~> m or kg m-2] + real, dimension(GV%ke+1) :: dz ! The change in interface heights interpolated to + ! a velocity point [H ~> m or kg m-2] + logical :: PCM(GV%ke) ! If true, do PCM remapping from a cell. + real :: u_src(GV%ke) ! A column of u-velocities on the source grid [L T-1 ~> m s-1] + real :: u_tgt(GV%ke) ! A column of u-velocities on the target grid [L T-1 ~> m s-1] + real :: v_src(GV%ke) ! A column of v-velocities on the source grid [L T-1 ~> m s-1] + real :: v_tgt(GV%ke) ! A column of v-velocities on the target grid [L T-1 ~> m s-1] + real :: h1(GV%ke) ! A column of source grid layer thicknesses [H ~> m or kg m-2] + real :: h2(GV%ke) ! A column of target grid layer thicknesses [H ~> m or kg m-2] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] + logical :: show_call_tree + integer :: i, j, k, nz + + show_call_tree = .false. + if (present(debug)) show_call_tree = debug + if (show_call_tree) call callTree_enter("ALE_remap_velocities()") + + ! If remap_uv_using_old_alg is .true. and u or v is requested, then we must have dzInterface. Otherwise, + ! u and v can be remapped without dzInterface + if (CS%remap_uv_using_old_alg .and. .not.present(dzInterface) ) call MOM_error(FATAL, & + "ALE_remap_velocities: dzInterface must be present if using old algorithm.") + + if (CS%answer_date >= 20190101) then + h_neglect = GV%H_subroundoff ; h_neglect_edge = GV%H_subroundoff + elseif (GV%Boussinesq) then + h_neglect = GV%m_to_H*1.0e-30 ; h_neglect_edge = GV%m_to_H*1.0e-10 + else + h_neglect = GV%kg_m2_to_H*1.0e-30 ; h_neglect_edge = GV%kg_m2_to_H*1.0e-10 + endif + + nz = GV%ke + + if (CS%partial_cell_vel_remap) then h_tot(:,:) = 0.0 do k=1,GV%ke ; do j=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 h_tot(i,j) = h_tot(i,j) + h_old(i,j,k) @@ -962,13 +875,12 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ! Remap u velocity component - if ( present(u) ) then + if ( .true. ) then !$OMP parallel do default(shared) private(h1,h2,dz,u_src,h_mask_vel,u_tgt) do j=G%jsc,G%jec ; do I=G%IscB,G%IecB ; if (G%mask2dCu(I,j)>0.) then ! Build the start and final grids do k=1,nz - u_src(k) = u(I,j,k) h1(k) = 0.5*(h_old(i,j,k) + h_old(i+1,j,k)) h2(k) = 0.5*(h_new(i,j,k) + h_new(i+1,j,k)) enddo @@ -994,6 +906,9 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ; endif ! --- Remap u profiles from the source vertical grid onto the new target grid. + do k=1,nz + u_src(k) = u(I,j,k) + enddo call remapping_core_h(CS%vel_remapCS, nz, h1, u_src, nz, h2, u_tgt, & h_neglect, h_neglect_edge) @@ -1007,15 +922,14 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ; enddo ; enddo endif - if (show_call_tree) call callTree_waypoint("u remapped (remap_all_state_vars)") + if (show_call_tree) call callTree_waypoint("u remapped (ALE_remap_velocities)") ! Remap v velocity component - if ( present(v) ) then + if ( .true. ) then !$OMP parallel do default(shared) private(h1,h2,v_src,dz,h_mask_vel,v_tgt) do J=G%JscB,G%JecB ; do i=G%isc,G%iec ; if (G%mask2dCv(i,J)>0.) then ! Build the start and final grids do k=1,nz - v_src(k) = v(i,J,k) h1(k) = 0.5*(h_old(i,j,k) + h_old(i,j+1,k)) h2(k) = 0.5*(h_new(i,j,k) + h_new(i,j+1,k)) enddo @@ -1039,6 +953,9 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ; endif ! --- Remap v profiles from the source vertical grid onto the new target grid. + do k=1,nz + v_src(k) = v(i,J,k) + enddo call remapping_core_h(CS%vel_remapCS, nz, h1, v_src, nz, h2, v_tgt, & h_neglect, h_neglect_edge) @@ -1052,20 +969,13 @@ subroutine remap_all_state_vars(CS, G, GV, h_old, h_new, Reg, OBC, & endif ; enddo ; enddo endif - if (CS%id_vert_remap_h > 0) call post_data(CS%id_vert_remap_h, h_old, CS%diag) - if ((CS%id_vert_remap_h_tendency > 0) .and. present(dt)) then - do k = 1, nz ; do j = G%jsc,G%jec ; do i = G%isc,G%iec - work_cont(i,j,k) = (h_new(i,j,k) - h_old(i,j,k))*Idt - enddo ; enddo ; enddo - call post_data(CS%id_vert_remap_h_tendency, work_cont, CS%diag) - endif - if (show_call_tree) call callTree_waypoint("v remapped (remap_all_state_vars)") - if (show_call_tree) call callTree_leave("remap_all_state_vars()") + if (show_call_tree) call callTree_waypoint("v remapped (ALE_remap_velocities)") + if (show_call_tree) call callTree_leave("ALE_remap_velocities()") -end subroutine remap_all_state_vars +end subroutine ALE_remap_velocities -!> Mask out thicknesses to 0 when their runing sum exceeds a specified value. +!> Mask out thicknesses to 0 when their running sum exceeds a specified value. subroutine apply_partial_cell_mask(h1, h_mask) real, dimension(:), intent(inout) :: h1 !< A column of thicknesses to be masked out after their !! running vertical sum exceeds h_mask [H ~> m or kg m-2] @@ -1125,10 +1035,11 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c integer, intent(in) :: nk_src !< Number of levels on source grid real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: h_src !< Level thickness of source grid !! [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid + real, dimension(SZI_(G),SZJ_(G),nk_src), intent(in) :: s_src !< Scalar on source grid, in arbitrary units [A] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(in) :: h_dst !< Level thickness of destination grid !! [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)),intent(inout) :: s_dst !< Scalar on destination grid, in the same + !! arbitrary units as s_src [A] logical, optional, intent(in) :: all_cells !< If false, only reconstruct for !! non-vanished cells. Use all vanished !! layers otherwise (default). @@ -1142,8 +1053,8 @@ subroutine ALE_remap_scalar(CS, G, GV, nk_src, h_src, s_src, h_dst, s_dst, all_c !! for remapping ! Local variables integer :: i, j, k, n_points - real :: dx(GV%ke+1) - real :: h_neglect, h_neglect_edge + real :: dx(GV%ke+1) ! Change in interface position [H ~> m or kg m-2] + real :: h_neglect, h_neglect_edge ! Tiny thicknesses used in remapping [H ~> m or kg m-2] logical :: ignore_vanished_layers, use_remapping_core_w, use_2018_remap ignore_vanished_layers = .false. @@ -1222,18 +1133,18 @@ subroutine ALE_PLM_edge_values( CS, G, GV, h, Q, bdry_extrap, Q_t, Q_b ) real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: Q !< 3d scalar array + intent(in) :: Q !< 3d scalar array, in arbitrary units [A] logical, intent(in) :: bdry_extrap !< If true, use high-order boundary !! extrapolation within boundary cells real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: Q_t !< Scalar at the top edge of each layer + intent(inout) :: Q_t !< Scalar at the top edge of each layer [A] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: Q_b !< Scalar at the bottom edge of each layer + intent(inout) :: Q_b !< Scalar at the bottom edge of each layer [A] ! Local variables integer :: i, j, k - real :: slp(GV%ke) - real :: mslp - real :: h_neglect + real :: slp(GV%ke) ! Tracer slope times the cell width [A] + real :: mslp ! Monotonized tracer slope times the cell width [A] + real :: h_neglect ! Tiny thicknesses used in remapping [H ~> m or kg m-2] if (CS%answer_date >= 20190101) then h_neglect = GV%H_subroundoff @@ -1281,13 +1192,13 @@ subroutine TS_PPM_edge_values( CS, S_t, S_b, T_t, T_b, G, GV, tv, h, bdry_extrap type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(ALE_CS), intent(inout) :: CS !< module control structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: S_t !< Salinity at the top edge of each layer + intent(inout) :: S_t !< Salinity at the top edge of each layer [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: S_b !< Salinity at the bottom edge of each layer + intent(inout) :: S_b !< Salinity at the bottom edge of each layer [S ~> ppt] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: T_t !< Temperature at the top edge of each layer + intent(inout) :: T_t !< Temperature at the top edge of each layer [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(inout) :: T_b !< Temperature at the bottom edge of each layer + intent(inout) :: T_b !< Temperature at the bottom edge of each layer [C ~> degC] type(thermo_var_ptrs), intent(in) :: tv !< thermodynamics structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & intent(in) :: h !< layer thicknesses [H ~> m or kg m-2] @@ -1386,7 +1297,9 @@ end subroutine ALE_initRegridding function ALE_getCoordinate( CS ) type(ALE_CS), pointer :: CS !< module control structure - real, dimension(CS%nk+1) :: ALE_getCoordinate + real, dimension(CS%nk+1) :: ALE_getCoordinate !< The coordinate positions, in the appropriate units + !! of the target coordinate, e.g. [Z ~> m] for z*, + !! non-dimensional for sigma, etc. ALE_getCoordinate(:) = getCoordinateInterfaces( CS%regridCS, undo_scaling=.true. ) end function ALE_getCoordinate @@ -1416,7 +1329,7 @@ subroutine ALE_update_regrid_weights( dt, CS ) real, intent(in) :: dt !< Time-step used between ALE calls [T ~> s] type(ALE_CS), pointer :: CS !< ALE control structure ! Local variables - real :: w ! An implicit weighting estimate. + real :: w ! An implicit weighting estimate [nondim] if (associated(CS)) then w = 0.0 @@ -1443,7 +1356,7 @@ subroutine ALE_updateVerticalGridType(CS, GV) GV%zAxisUnits = getCoordinateUnits( CS%regridCS ) GV%zAxisLongName = getCoordinateShortName( CS%regridCS ) GV%direction = -1 ! Because of ferret in z* mode. Need method to set - ! as function of coordinae mode. + ! as function of coordinate mode. end subroutine ALE_updateVerticalGridType diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e5ce4019ba..de287af98a 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -137,7 +137,7 @@ module MOM_regridding ! The following routines are visible to the outside world public initialize_regridding, end_regridding, regridding_main public regridding_preadjust_reqs, convective_adjustment -public inflate_vanished_layers_old, check_remapping_grid, check_grid_column +public inflate_vanished_layers_old, check_grid_column public set_regrid_params, get_regrid_size, write_regrid_file public uniformResolution, setCoordinateResolution public set_target_densities_from_GV, set_target_densities @@ -794,7 +794,7 @@ end subroutine end_regridding !------------------------------------------------------------------------------ !> Dispatching regridding routine for orchestrating regridding & remapping -subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, conv_adjust, & +subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, & frac_shelf_h, PCM_cell) !------------------------------------------------------------------------------ ! This routine takes care of (1) building a new grid and (2) remapping between @@ -823,24 +823,14 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, conv_ type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamical variables (T, S, ...) real, dimension(SZI_(G),SZJ_(G),CS%nk), intent(inout) :: h_new !< New 3D grid consistent with target coordinate real, dimension(SZI_(G),SZJ_(G),CS%nk+1), intent(inout) :: dzInterface !< The change in position of each interface - logical, intent(in ) :: conv_adjust !< If true, regridding_main should do - !! convective adjustment, but because it no - !! longer does convective adjustment this must - !! be false. This argument has been retained to - !! trap inconsistent code, but will eventually - !! be eliminated. real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: frac_shelf_h !< Fractional ice shelf coverage logical, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(out ) :: PCM_cell !< Use PCM remapping in cells where true ! Local variables real :: trickGnuCompiler + integer :: i, j - if (conv_adjust) call MOM_error(FATAL, & - "regridding_main: convective adjustment no longer is done inside of regridding_main. "//& - "The code needs to be modified to call regridding_main() with conv_adjust=.false, "//& - "and a call to convective_adjustment added before calling regridding_main() "//& - "if regridding_preadjust_reqs() indicates that this is necessary.") if (present(PCM_cell)) PCM_cell(:,:,:) = .false. select case ( CS%regridding_scheme ) @@ -879,8 +869,18 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, conv_ end select ! type of grid #ifdef __DO_SAFETY_CHECKS__ - if (CS%nk == GV%ke) call check_remapping_grid(G, GV, h, dzInterface,'in regridding_main') + if (CS%nk == GV%ke) then + do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 ; if (G%mask2dT(i,j)>0.) then + call check_grid_column( GV%ke, h(i,j,:), dzInterface(i,j,:), 'in regridding_main') + endif ; enddo ; enddo + endif #endif + do j=G%jsc,G%jec ; do i=G%isc,G%iec ; if (G%mask2dT(i,j) > 0.) then + if (minval(h(i,j,:)) < 0.0) then + write(0,*) 'regridding_main check_grid: i,j=', i, j, 'h_new(i,j,:)=', h_new(i,j,:) + call MOM_error(FATAL, "regridding_main: negative thickness encountered.") + endif + endif ; enddo ; enddo end subroutine regridding_main @@ -952,23 +952,6 @@ subroutine calc_h_new_by_dz(CS, G, GV, h, dzInterface, h_new) end subroutine calc_h_new_by_dz -!> Check that the total thickness of two grids match -subroutine check_remapping_grid( G, GV, h, dzInterface, msg ) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzInterface !< Change in interface positions - !! [H ~> m or kg m-2] - character(len=*), intent(in) :: msg !< Message to append to errors - ! Local variables - integer :: i, j - - !$OMP parallel do default(shared) - do j = G%jsc-1,G%jec+1 ; do i = G%isc-1,G%iec+1 - if (G%mask2dT(i,j)>0.) call check_grid_column( GV%ke, h(i,j,:), dzInterface(i,j,:), msg ) - enddo ; enddo - -end subroutine check_remapping_grid !> Check that the total thickness of new and old grids are consistent subroutine check_grid_column( nk, h, dzInterface, msg ) diff --git a/src/ALE/_ALE.dox b/src/ALE/_ALE.dox index 9313ed2aa1..b3b4f54213 100644 --- a/src/ALE/_ALE.dox +++ b/src/ALE/_ALE.dox @@ -1,90 +1,184 @@ -/*! \page ALE ALE +/*! \page ALE Vertical Lagrangian method: conceptual -\section section_ALE Basics of the Vertical Lagrangian-Remap Method in MOM6 +\section section_ALE Lagrangian and ALE -As discussed by \cite adcroft2006, there are two general classes +As discussed by Adcroft and Hallberg (2008) \cite adcroft2006 and +Griffies, Adcroft and Hallberg (2020) \cite Griffies_Adcroft_Hallberg2020, +we can conceive of two general classes of algorithms that frame how hydrostatic ocean models are formulated. The two classes differ in how they treat the vertical direction. Quasi-Eulerian methods follow the approach traditionally -used in geopotential coordinate models, whereby vertical motion -is diagnosed via the continuity equation. Quasi-Lagrangian -methods are traditionally used by layered isopycnal models, with -the Lagrangian approach specifying motion that crosses coordinate +used in geopotential coordinate models, whereby vertical motion is +diagnosed via the continuity equation. Quasi-Lagrangian methods are +traditionally used by layered isopycnal models, with the vertical +Lagrangian approach specifying motion that crosses coordinate surfaces. Indeed, such dia-surface flow can be set to zero using -Lagrangian methods for studies of adiabatic dynamics. MOM6 makes -use of the vertical Lagrangian remap method, as pioneered for -ocean modeling by \cite bleck2002, which is a limit case of the -Arbitrary-Lagrangian-Eulerian method (\cite hirt1997). Dia-surface +Lagrangian methods for studies of adiabatic dynamics. MOM6 makes use +of the vertical Lagrangian remap method, as pioneered for ocean +modeling by Bleck (2002) \cite bleck2002 and further documented by +\cite Griffies_Adcroft_Hallberg2020, with this method a limit case of +the Arbitrary-Lagrangian-Eulerian method (\cite hirt1997). Dia-surface transport is implemented via a remapping so that the method can be -summarized as the Lagrangian plus remap approach and is essentially -a one-dimensional version of the incremental remapping of +summarized as the Lagrangian plus remap approach and so it is a +one-dimensional version of the incremental remapping of Dukowicz (2000) \cite dukowicz2000. -The MOM6 implementation of the vertical Lagrangian-remap method makes use -of two general steps. The first evolves the ocean state forward in -time according to a vertical Lagrangian limit with \f$\dot{r}=0\f$. Hence, -the horizontal momentum, thickness, and tracers are time stepped -with the red terms removed in equations \eqref{eq:h-horz-momentum,h-equations,momentum}, -\eqref{eq:h-thickness-equation,h-equations,thickness}, \eqref{eq:h-temperature-equation,h-equations,potential temperature}, -and \eqref{eq:h-salinity-equation,h-equations,salinity}. All advective transport thus -occurs within a layer as defined by constant \f$r\f$-surfaces so that -the volume within each layer is fixed. All other terms are retained in -their full form, including subgrid scale terms that contribute to -the transfer of tracer and momentum into distinct \f$r\f$ layers (e.g., -dia-surface diffusion of tracer and velocity). Maintaining constant -volume within a layer yet allowing for tracers to move between layers -engenders no inconsistency between tracer and thickness evolution. The -reason is that tracer diffusion, even dia-surface diffusion, does -not transfer volume. +\image html ALE_general_schematic.png "Schematic of the 3d Lagrangian regrid/remap method" width=70% +\image latex ALE_general_schematic.png "Schematic of the 3d Lagrangian regrid/remap method" width=0.7\textwidth -The second step in the algorithm comprises the generation of a new +Refer to the above figure taken from Griffies, Adcroft, and Hallberg +(2020) \cite Griffies_Adcroft_Hallberg2020. It shows a schematic of +the Lagrangian-remap method as well as the Arbitrary +Lagrangian-Eulerian (ALE) method. The first panel shows a square fluid +region and square grid used to represent the fluid, along with +rectangular subregions partitioned by grid lines. The second panel +shows the result of evolving the fluid region and evolving the +grid. The grid can evolve according to the fluid flow, as per a +Lagrangian method, or it can evolve according to some specified grid +evolution, as per an ALE method. The right panel depicts the grid +reinitialization onto a target grid (the regrid step). A regrid step +necessitates a corresponding remap step to estimate the ocean state on +the target grid, with conservative remapping required to preserve +integrated scalar contents (e.g., potential enthalpy, salt mass, and +seawater mass). The regrid/remap steps are needed for Lagrangian +methods in order for the grid to retain an accurate representation of +the ocean state. Ideally, the remap step does not affect any changes +to the fluid state; rather, it only modifies where in space the fluid +state is represented. However, any numerical realization incurs +interpolation inaccuracies that lead to unphysical (spurious) state +changes. + +\section section_ALE_MOM Vertical Lagrangian regrid/remap method + +We now get a bit more specific to the vertical Lagrangian method. +For this purpose, recall recall the basic dynamical equations (those +equations with a time derivative) of MOM6 discussed in +\ref General_Coordinate +\f{align} +\rho_0 +\left[ \frac{\partial \mathbf{u}}{\partial t} + \frac{( f + \zeta )}{h} \, +\hat{\mathbf{z}} \times h \, \mathbf{u} + \underbrace{ \dot{r} \, +\frac{\partial \mathbf{u}}{\partial r} } +\right] +&= -\nabla_r \, (p + \rho_{0} \, K) - +\rho \nabla_r \, \Phi + \mathbf{\mathcal{F}} +&\mbox{horizontal momentum} +\label{eq:h-horz-momentum-vlm} +\\ +\frac{\partial h}{\partial t} + \nabla_r \cdot \left( h \, \mathbf{u} \right) + +\underbrace{ \delta_r ( z_r \dot{r} ) } + &= 0 +&\mbox{thickness} +\label{eq:h-thickness-equation-vlm} +\\ +\frac{\partial ( \theta \, h )}{\partial t} + \nabla_r \cdot \left( \theta h \, +\mathbf{u} \right) + \underbrace{ \delta_r ( \theta \, z_r \dot{r} ) } +&= +h \mathbf{\mathcal{N}}_\theta^\gamma - \delta_r J_\theta^{(z)} +&\mbox{potential/Conservative temp} +\label{eq:h-temperature-equation-vlm} + \\ +\frac{\partial ( S \, h )}{\partial t} + \nabla_r \cdot \left( S \, h \, +\mathbf{u} \right) + \underbrace{ \delta_r ( S \, z_r \dot{r} ) } + &= +h \mathbf{\mathcal{N}}_S^\gamma - \delta_r J_S^{(z)} +&\mbox{salinity} +\label{eq:h-salinity-equation-vlm} +\f} +The MOM6 implementation of the vertical Lagrangian method makes +use of two general steps. The first evolves the ocean state forward in +time according to a vertical Lagrangian approach with with +\f$\dot{r}=0\f$. Hence, the horizontal momentum, thickness, and +tracers are time stepped with the underbraced terms removed in the +above equations. All advective transport occurs within a layer as +defined by constant \f$r\f$-surfaces so that the volume within each +layer is fixed. All other terms are retained in their full form, +including subgrid scale terms that contribute to the transfer of +tracer and momentum into distinct \f$r\f$ layers (e.g., dia-surface +diffusion of tracer and velocity). Maintaining constant volume within +a layer yet allowing for tracers to move between layers engenders no +inconsistency between tracer and thickness evolution. The reason is +that tracer diffusion, even dia-surface diffusion, does not transfer +volume. + +The second step in the method comprises the generation of a new vertical grid following a prescription, such as whether the grid -should align with isopcynals or constant \f$z^{*}\f$ or a combination. The -ocean state is then vertically remapped to the newly generated vertical -grid. The remapping step incorporates dia-surface transfer of properties, -with such transfer depending on the prescription given for the vertical +should align with isopcynals or constant \f$z^{*}\f$ or a combination. +This second step is known as the regrid step. The ocean state is then +vertically remapped to the newly generated vertical grid. This +remapping step incorporates dia-surface transfer of properties, with +such transfer depending on the prescription given for the vertical grid generation. To minimize discretization errors and the associated -spurious mixing, the remapping step makes use of the high order accurate -methods developed by \cite white2008 and \cite white2009. +spurious mixing, the remapping step makes use of the high order +accurate methods developed by \cite white2008 and \cite white2009. -The underlying algorithm for treatment of the vertical can -be related to operator-splitting of the red terms in equations -\eqref{eq:h-thickness-equation,h-equations,thickness}--\eqref{eq:h-temperature-equation,h-equations,potential temperature}. If we -consider, for simplicity, an Euler-forward update for a time-step \f$\Delta -t\f$, the time-stepping for the continuity and temperature equation can -be summarized as -\f{eqnarray} -\label{html:ale-equations}\notag \\ -h^\dagger &= h^{(n)} - \Delta t \left[ \nabla_r \cdot \left( h \, \mathbf{u} \right) \right] -&\mbox{thickness} \label{eq:ale-thickness-equation} \\ -\theta^\dagger \, h^\dagger &= \theta^{(n)} \, h^{(n)} - \Delta t \left[ \nabla_r \cdot \left( \theta h \, \mathbf{u} \right) - h \boldsymbol{\mathcal{N}}_\theta^\gamma + \delta_r J_\theta^{(z)} \right] -&\;\;\;\;\mbox{potential temp} \label{eq:ale-temperature-equation} \\ -h^{(n+1)} &= h^\dagger - \Delta t \, \delta_r \left( z_r \dot{r} \right) -&\mbox{move grid} \label{eq:ale-new-grid} \\ -\theta^{(n+1)} h^{(n+1)} &= \theta^\dagger h^\dagger - \Delta t \, \delta_r \left( z_r \dot{r} \, \theta^\dagger \right) -&\mbox{remap temperature.} \label{eq:ale-remap-temperature} -\f} +\section section_ALE_MOM_numerics Outlining the numerical algorithm -Substituting \eqref{eq:ale-thickness-equation,ale-equations,thickness} into \eqref{eq:ale-new-grid,ale-equations,move grid} -recovers a time-discrete form of \eqref{eq:h-thickness-equation,h-equations,thickness}. The -intermediate quantities indicated by \f$^\dagger\f$-symbols are the result of -the vertical Lagrangian step of the algorithm. What were the red terms in -the continuous-in-time equations are used to evolve the the intermediate -quantities to the final updated quantities each step. In MOM6, equation -\eqref{eq:ale-new-grid,ale-equations,move grid} is essentially used to define the dia-surface -transport \f$z_r \dot{r}\f$ by prescribing \f$h^{(n+1)}\f$. For example, to -recover a z-coordinate model, \f$h^{(n+1)}=\Delta z\f$, and \f$z_r \dot{r}\f$ -becomes the Eulerian vertical velocity, \f$w\f$. +The underlying algorithm for treatment of the vertical can be related +to operator-splitting of the underbraced terms in the above equations. +If we consider, for simplicity, an Euler-forward update for a +time-step \f$\Delta t\f$, the time-stepping for the thickness and +tracer equation (\f$C\f$ is an arbitrary tracer) can be summarized as +(from Table 1 in Griffies, Adcroft and Hallberg (2020) +\cite Griffies_Adcroft_Hallberg2020) +\f{align} +\label{html:ale-equations}\notag +\\ + \delta_{r} w^{\scriptstyle{\mathrm{grid}}} + &= -\nabla_{r} \cdot [h \, \mathbf{u}]^{(n)} + &\mbox{layer motion via horz conv} +\\ + h^{\dagger} &= h^{(n)} + \Delta t \, \delta_{r} w^{\scriptstyle{\mathrm{grid}}} += h^{(n)} - \Delta t \, \nabla_{r} \cdot [h \, \mathbf{u}]^{(n)} + &\mbox{update thickness via horz advect} +\\ + [h \, C]^{\dagger} &= [h \, C]^{(n)} -\Delta t \, \nabla_{r} \cdot [ h \, C \, \mathbf{u} ]^{(n)} + &\mbox{update tracer via horz advect} +\\ + h^{(n+1)} &= h^{\scriptstyle{\mathrm{target}}} + &\mbox{regrid to the target grid} +\\ + \delta_{r} w^{(\dot{r})} &= -(h^{\scriptstyle{\mathrm{target}}} - h^{\dagger})/\Delta t + &\mbox{diagnose dia-surface transport} +\\ + [h \, C]^{(n+1)} &= [h \, C]^{\dagger} - \Delta t \, \delta_{r} ( w^{(\dot{r})} \, C^{\dagger}) + &\mbox{remap tracer via dia-surface transport} +\f} +The first three equations constitute the Lagrangian portion of the +algorithm. In particular, the second equation provides an +intermediate or predictor value for the updated thickness, +\f$h^{\dagger}\f$, resulting from the vertical Lagrangian update. +Similarly, the third equation performs a Lagrangian update of the +thickness-weighted tracer to intermediate values, again operationally +realized by dropping the \f$w^{(\dot{r})}\f$ contribution. +The fourth equation is the regrid step, which is the key step in the +algorithm with the new grid defined by the new thickness +\f$h^{(n+1)}\f$. The new thickness is prescribed by the target values +for the vertical grid, +\f{align} + h^{(n+1)} = h^{\scriptstyle{\mathrm{target}}}. +\f} +The prescribed target grid thicknesses are then used to diagnose the +dia-surface velocity according to +\f{align} + \delta_{r} w^{(\dot{r})} = -(h^{\scriptstyle{\mathrm{target}}} - h^{\dagger})/\Delta t. +\f} +This step, and the remaining step for tracers, constitute the +remapping portion of the algorithm. For example, if the prescribed +coordinate surfaces are geopotentials, then \f$w^{(\dot{r})}\f$ and +\f$h^{\scriptstyle{\mathrm{target}}} = h^{(n)}\f$, in which case the +remap step reduces to Cartesian vertical advection. Within the above framework for evolving the ocean state, we make use of a standard split-explicit time stepping method by decomposing the horizontal momentum equation into its fast (depth integrated) and slow -(deviation from depth integrated) components. Furthermore, we follow the -methods of \cite hallberg2009 to ensure that the free surface resulting -from time stepping the depth integrated thickness equation (i.e., the -free surface equation) is consistent with the sum of the thicknesses -that result from time stepping the layer thickness equations for each -of the discretized layers; i.e., \f$\sum_{k} h = H + \eta\f$. +(deviation from depth integrated) components. Furthermore, we follow +the methods of Hallberg and Adcroft (2009) \cite hallberg2009 to +ensure that the free surface resulting from time stepping the depth +integrated thickness equation (i.e., the free surface equation) is +consistent with the sum of the thicknesses that result from time +stepping the layer thickness equations for each of the discretized +layers; i.e., \f$\sum_{k} h = H + \eta\f$. */ diff --git a/src/ALE/_ALE_timestep.dox b/src/ALE/_ALE_timestep.dox index e6da55fda9..04ed495e77 100644 --- a/src/ALE/_ALE_timestep.dox +++ b/src/ALE/_ALE_timestep.dox @@ -1,50 +1,62 @@ -/*! \page ALE_Timestep ALE Timestep - -\section section_ALE_remap Explanation of ALE remapping - -The Arbitrary Lagrangian-Eulerian (ALE) remapping is not a timestep in the traditional -sense, but rather an operation performed to bring the vertical coordinate back to the target -specification. This remapping can be less frequent than the momentum or -thermodynamic timesteps, but must be done before the layer interfaces become entangled -with each other. - -Assuming the target vertical grid is level \f$z\f$-surfaces, the initial state is -shown on the left in the following figure: - -\image html remapping1.png "The initial state with level surface (left) and the perturbed state after a wave has come through (right)." -\image latex remapping1.png "The initial state with level surface (left) and the perturbed state after a wave has come through (right)." - -Some time later, a wave has perturbed the surfaces which move with the -fluid and it has been determined that a remapping operation is needed. The -target vertical grid is still level \f$z\f$-surfaces, so this new target -grid is shown overlaid on the left as regrid: - -\image html remapping2.png "The regrid operation (left) and the remap operation (right)." -\image latex remapping2.png "The regrid operation (left) and the remap operation (right)." - -The complex part of the operation is remapping the wavy field onto the new grid as -shown on the right and again in the final frame after the old deformed coordinate -system has been deleted: - -\image html remapping3.png "The final state after remapping." -\image latex remapping3.png "The final state after remapping." - -Mathematically, the new layer thicknesses, \f$h_k\f$, are computed and then populated -with the new velocities and tracers: - -\f[ - h_k^{\mbox{new}} = \nabla_k z_{\mbox{coord}} -\f] -\f[ - \sum h_k^{\mbox{new}} = \sum h_k^{\mbox{old}} -\f] -\f[ - \vec{u}_k^{\mbox{new}} = \frac{1}{h_k} \int_{z_{k + \frac{1}{2}}}^{z_{k + - \frac{1}{2}} + h_k} \vec{u}^{\mbox{old}}(z')dz' -\f] -\f[ - \theta^{\mbox{new}} = \frac{1}{h_k} \int_{z_{k + \frac{1}{2}}}^{z_{k + - \frac{1}{2}} + h_k} \theta^{\mbox{old}}(z')dz' -\f] +/*! \page ALE_Timestep Vertical Lagrangian method in pictures + +\section section_ALE_remap Graphical explanation of vertical Lagrangian method + +Vertical Lagrangian regridding/remapping is not a timestep method in +the traditional sense. Rather, it is a sequence of operations +performed to bring the vertical grid back to a target specification +(the regrid step), and then to remap the ocean state onto this new +grid (the remap step). This regrid/remap process can be chosen to be +less frequent than the momentum or thermodynamic timesteps. We are +motivated to choose less frequent regrid/remap steps to save +computational time and to reduce spurious mixing that occurs due to +truncation errors in the remap step. However, there is a downside to +delaying the regrid/remap. Namely, if delayed too long then the layer +interfaces can become entangled (i.e., no longer monotonic in the +vertical), which is a common problem with purely Lagrangian methods. +On this page we illustrate the regrid/remap steps by making use of +Figure 3 from Griffies, Adcroft, and Hallberg (2020) +\cite Griffies_Adcroft_Hallberg2020. + +For purposes of this example, assume that the target vertical grid is +comprised of geopotential \f$z\f$-surfaces, with the initial ocean +state (e.g., the temperature field) shown on the left in the following +figure. + +\image html remapping1.png "Initial state with level surface (left) and perturbed state after a wave has come through (right)" width=60% +\image latex remapping1.png "Initial state with level surface (left) and perturbed state after a wave has come through (right)" width=0.6\textwidth + +Some time later, assume a wave has perturbed the ocean state. During +the Lagrangian portion of the algorithm, the coordinate surfaces move +vertically with the ocean fluid according to \f$\dot{r}=0\f$. Assume +now that the algorithm has determined that a regrid step is needed, +with the target vertical grid still geopotential \f$z\f$-surfaces, so +this new target grid is shown overlaid on the left as a regrid. + +\image html remapping2.png "The regrid operation (left) and the remap operation (right)" width=60% +\image latex remapping2.png "The regrid operation (left) and the remap operation (right)" width=0.6\textwidth + +The most complex part of the method involves remapping the wavy ocean +field onto the new grid. This step also incurs truncation errors that +are a function of the vertical grid spacing and the numerical method +used to perform the remapping. We illustrate this remap step in the +figure above, as well as in the frame below shown after the old +deformed coordinate grid has been deleted: + +\image html remapping3.png "The final state after regriddinig and remapping" width=30% +\image latex remapping3.png "The final state after regridding and remapping" width=0.3\textwidth + +The new layer thicknesses, \f$h_k\f$, are computed and then the layers +are populated with the new velocities and tracers +\f{align} + \sum h_k^{\scriptstyle{\mathrm{new}}} &= \sum h_k^{\scriptstyle{\mathrm{old}}} +\\ + \mathbf{u}_k^{\scriptstyle{\mathrm{new}}} + &= \frac{1}{h_k} + \int_{z_{k + 1/2}}^{z_{k + 1/2} + h_k} \mathbf{u}^{\scriptstyle{\mathrm{old}}}(z') \, \mathrm{d}z' +\\ + \theta_k^{\scriptstyle{\mathrm{new}}} &= \frac{1}{h_k} + \int_{z_{k + 1/2}}^{z_{k + 1/2} + h_k} \theta^{\scriptstyle{\mathrm{old}}}(z') \, \mathrm{d}z' +\f} */ diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 78170064ff..c61f130ef7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -50,9 +50,11 @@ module MOM use MOM_unit_tests, only : unit_tests ! MOM core modules -use MOM_ALE, only : ALE_init, ALE_end, ALE_main, ALE_CS, adjustGridForIntegrity +use MOM_ALE, only : ALE_init, ALE_end, ALE_regrid, ALE_CS, adjustGridForIntegrity use MOM_ALE, only : ALE_getCoordinate, ALE_getCoordinateUnits, ALE_writeCoordinateFile -use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, ALE_register_diags +use MOM_ALE, only : ALE_updateVerticalGridType, ALE_remap_init_conds, pre_ALE_adjustments +use MOM_ALE, only : ALE_remap_tracers, ALE_remap_velocities +use MOM_ALE, only : ALE_update_regrid_weights, pre_ALE_diagnostics, ALE_register_diags use MOM_ALE_sponge, only : rotate_ALE_sponge, update_ALE_sponge_field use MOM_barotropic, only : Barotropic_CS use MOM_boundary_update, only : call_OBC_register, OBC_register_end, update_OBC_CS @@ -90,6 +92,8 @@ module MOM use MOM_hor_index, only : hor_index_type, hor_index_init use MOM_hor_index, only : rotate_hor_index use MOM_interface_heights, only : find_eta +use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end +use MOM_interface_filter, only : interface_filter_CS use MOM_lateral_mixing_coeffs, only : calc_slope_functions, VarMix_init, VarMix_end use MOM_lateral_mixing_coeffs, only : calc_resoln_function, calc_depth_function, VarMix_CS use MOM_MEKE, only : MEKE_alloc_register_restart, step_forward_MEKE @@ -103,6 +107,8 @@ module MOM use MOM_open_boundary, only : open_boundary_register_restarts use MOM_open_boundary, only : update_segment_tracer_reservoirs use MOM_open_boundary, only : rotate_OBC_config, rotate_OBC_init +use MOM_porous_barriers, only : porous_widths_layer, porous_widths_interface, porous_barriers_init +use MOM_porous_barriers, only : porous_barrier_CS use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML use MOM_set_visc, only : set_visc_register_restarts, set_visc_CS use MOM_set_visc, only : set_visc_init, set_visc_end @@ -132,7 +138,7 @@ module MOM use MOM_unit_scaling, only : unit_scale_type, unit_scaling_init use MOM_unit_scaling, only : unit_scaling_end, fix_restart_unit_scaling use MOM_variables, only : surface, allocate_surface_state, deallocate_surface_state -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type use MOM_variables, only : accel_diag_ptrs, cont_diag_ptrs, ocean_internal_state use MOM_variables, only : rotate_surface_state use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd @@ -141,8 +147,6 @@ module MOM use MOM_wave_interface, only : wave_parameters_CS, waves_end, waves_register_restarts use MOM_wave_interface, only : Update_Stokes_Drift -use MOM_porous_barriers, only : porous_widths - ! Database client used for machine-learning interface use MOM_database_comms, only : dbcomms_CS_type, database_comms_init, dbclient_type @@ -158,7 +162,6 @@ module MOM use MOM_offline_main, only : offline_redistribute_residual, offline_diabatic_ale use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean use MOM_offline_main, only : offline_advection_layer, offline_transport_end -use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline use MOM_ice_shelf, only : ice_shelf_CS, ice_shelf_query, initialize_ice_shelf use MOM_particles_mod, only : particles, particles_init, particles_run, particles_save_restart, particles_end @@ -276,6 +279,8 @@ module MOM logical :: split !< If true, use the split time stepping scheme. logical :: use_RK2 !< If true, use RK2 instead of RK3 in unsplit mode !! (i.e., no split between barotropic and baroclinic). + logical :: interface_filter !< If true, apply an interface height filter immediately + !! after any calls to thickness_diffuse. logical :: thickness_diffuse !< If true, diffuse interface height w/ a diffusivity KHTH. logical :: thickness_diffuse_first !< If true, diffuse thickness before dynamics. logical :: mixedlayer_restrat !< If true, use submesoscale mixed layer restratifying scheme. @@ -363,6 +368,8 @@ module MOM type(thickness_diffuse_CS) :: thickness_diffuse_CSp !< Pointer to the control structure used for the isopycnal height diffusive transport. !! This is also common referred to as Gent-McWilliams diffusion + type(interface_filter_CS) :: interface_filter_CSp + !< Control structure used for the interface height smoothing operator. type(mixedlayer_restrat_CS) :: mixedlayer_restrat_CSp !< Pointer to the control structure used for the mixed layer restratification type(set_visc_CS) :: set_visc_CSp @@ -403,6 +410,8 @@ module MOM !< Pointer to the MOM diagnostics control structure type(offline_transport_CS), pointer :: offline_CSp => NULL() !< Pointer to the offline tracer transport control structure + type(porous_barrier_CS) :: por_bar_CS + !< Control structure for porous barrier logical :: ensemble_ocean !< if true, this run is part of a !! larger ensemble for the purpose of data assimilation @@ -411,13 +420,9 @@ module MOM !! ensemble model state vectors and data assimilation !! increments and priors type(dbcomms_CS_type) :: dbcomms_CS !< Control structure for database client used for online ML/AI - type(porous_barrier_ptrs) :: pbv !< porous barrier fractional cell metrics - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: por_face_areaU !< fractional open area of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: por_face_areaV !< fractional open area of V-faces [nondim] - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NK_INTERFACE_) :: por_layer_widthU !< fractional open width - !! of U-faces [nondim] - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NK_INTERFACE_) :: por_layer_widthV !< fractional open width - !! of V-faces [nondim] + logical :: use_porbar !< If true, use porous barrier to constrain the widths and face areas + !! at the edges of the grid cells. + type(porous_barrier_type) :: pbv !< porous barrier fractional cell metrics type(particles), pointer :: particles => NULL() ! NULL() !< a pointer to the stochastics control structure end type MOM_control_struct @@ -437,6 +442,7 @@ module MOM integer :: id_clock_adiabatic integer :: id_clock_continuity ! also in dynamics s/r integer :: id_clock_thick_diff +integer :: id_clock_int_filter integer :: id_clock_BBL_visc integer :: id_clock_ml_restrat integer :: id_clock_diagnostics @@ -1056,8 +1062,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights - !! for porous topo. [Z ~> m or 1/eta_to_m] G => CS%G ; GV => CS%GV ; US => CS%US ; IDs => CS%IDs is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1077,26 +1081,44 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif call cpu_clock_end(id_clock_varT) - if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse .and. CS%thickness_diffuse_first) then + if ((CS%t_dyn_rel_adv == 0.0) .and. CS%thickness_diffuse_first .and. & + (CS%thickness_diffuse .or. CS%interface_filter)) then call enable_averages(dt_thermo, Time_local+real_to_time(US%T_to_s*(dt_thermo-dt)), CS%diag) - call cpu_clock_begin(id_clock_thick_diff) - if (CS%VarMix%use_variable_mixing) & - call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & - CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) - call cpu_clock_end(id_clock_thick_diff) - call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) - call disable_averaging(CS%diag) - if (showCallTree) call callTree_waypoint("finished thickness_diffuse_first (step_MOM)") + if (CS%thickness_diffuse) then + call cpu_clock_begin(id_clock_thick_diff) + if (CS%VarMix%use_variable_mixing) & + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & + CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + call cpu_clock_end(id_clock_thick_diff) + call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) + if (showCallTree) call callTree_waypoint("finished thickness_diffuse_first (step_MOM)") + endif + + if (CS%interface_filter) then + call cpu_clock_begin(id_clock_int_filter) + call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & + CS%CDp, CS%interface_filter_CSp) + call cpu_clock_end(id_clock_int_filter) + call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) + if (showCallTree) call callTree_waypoint("finished interface_filter_first (step_MOM)") + endif + call disable_averaging(CS%diag) ! Whenever thickness changes let the diag manager know, target grids ! for vertical remapping may need to be regenerated. call diag_update_remap_grids(CS%diag) endif - !update porous barrier fractional cell metrics - call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + ! Update porous barrier fractional cell metrics + if (CS%use_porbar) then + call enable_averages(dt, Time_local, CS%diag) + call porous_widths_layer(h, CS%tv, G, GV, US, CS%pbv, CS%por_bar_CS) + call disable_averaging(CS%diag) + call pass_vector(CS%pbv%por_face_areaU, CS%pbv%por_face_areaV, & + G%Domain, direction=To_All+SCALAR_PAIR, clock=id_clock_pass, halo=CS%cont_stencil) + endif ! The bottom boundary layer properties need to be recalculated. if (bbl_time_int > 0.0) then @@ -1180,20 +1202,32 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & endif - if (CS%thickness_diffuse .and. .not.CS%thickness_diffuse_first) then - call cpu_clock_begin(id_clock_thick_diff) + if ((CS%thickness_diffuse .or. CS%interface_filter) .and. & + .not.CS%thickness_diffuse_first) then if (CS%debug) call hchksum(h,"Pre-thickness_diffuse h", G%HI, haloshift=0, scale=GV%H_to_m) - if (CS%VarMix%use_variable_mixing) & - call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) - call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & - CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + if (CS%thickness_diffuse) then + call cpu_clock_begin(id_clock_thick_diff) + if (CS%VarMix%use_variable_mixing) & + call calc_slope_functions(h, CS%tv, dt, G, GV, US, CS%VarMix, OBC=CS%OBC) + call thickness_diffuse(h, CS%uhtr, CS%vhtr, CS%tv, dt, G, GV, US, & + CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) + + if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) + call cpu_clock_end(id_clock_thick_diff) + call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) + if (showCallTree) call callTree_waypoint("finished thickness_diffuse (step_MOM)") + endif - if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) - call cpu_clock_end(id_clock_thick_diff) - call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) - if (showCallTree) call callTree_waypoint("finished thickness_diffuse (step_MOM)") + if (CS%interface_filter) then + call cpu_clock_begin(id_clock_int_filter) + call interface_filter(h, CS%uhtr, CS%vhtr, CS%tv, dt_thermo, G, GV, US, & + CS%CDp, CS%interface_filter_CSp) + call cpu_clock_end(id_clock_int_filter) + call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) + if (showCallTree) call callTree_waypoint("finished interface_filter (step_MOM)") + endif endif ! apply the submesoscale mixed layer restratification parameterization @@ -1354,7 +1388,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) end subroutine step_MOM_tracer_dyn !> MOM_step_thermo orchestrates the thermodynamic time stepping and vertical -!! remapping, via calls to diabatic (or adiabatic) and ALE_main. +!! remapping, via calls to diabatic (or adiabatic) and ALE_regrid. subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & Time_end_thermo, update_BBL, Waves) type(MOM_control_struct), intent(inout) :: CS !< Master MOM control structure @@ -1376,16 +1410,17 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & optional, pointer :: Waves !< Container for wave related parameters !! the fields in Waves are intent in here. + real :: h_new(SZI_(G),SZJ_(G),SZK_(GV)) ! Layer thicknesses after regridding [H ~> m or kg m-2] + real :: dzRegrid(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The change in grid interface positions due to regridding, + ! in the same units as thicknesses [H ~> m or kg m-2] + logical :: PCM_cell(SZI_(G),SZJ_(G),SZK_(GV)) ! If true, PCM remapping should be used in a cell. logical :: use_ice_shelf ! Needed for selecting the right ALE interface. logical :: showCallTree type(group_pass_type) :: pass_T_S, pass_T_S_h, pass_uv_T_S_h integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. integer :: halo_sz ! The size of a halo where data must be valid. - integer :: is, ie, js, je, nz - - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)+1) :: eta_por ! layer interface heights - !! for porous topo. [Z ~> m or 1/eta_to_m] + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke showCallTree = callTree_showQuery() @@ -1423,7 +1458,11 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! and set_viscous_BBL is called as a part of the dynamic stepping. call cpu_clock_begin(id_clock_BBL_visc) !update porous barrier fractional cell metrics - call porous_widths(h, CS%tv, G, GV, US, eta_por, CS%pbv) + if (CS%use_porbar) then + call porous_widths_interface(h, CS%tv, G, GV, US, CS%pbv, CS%por_bar_CS) + call pass_vector(CS%pbv%por_layer_widthU, CS%pbv%por_layer_widthV, & + G%Domain, direction=To_ALL+SCALAR_PAIR, clock=id_clock_pass, halo=CS%cont_stencil) + endif call set_viscous_BBL(u, v, h, tv, CS%visc, G, GV, US, CS%set_visc_CSp, CS%pbv) call cpu_clock_end(id_clock_BBL_visc) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_thermo)") @@ -1452,7 +1491,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & ! Regridding/remapping is done here, at end of thermodynamics time step ! (that may comprise several dynamical time steps) - ! The routine 'ALE_main' can be found in 'MOM_ALE.F90'. + ! The routine 'ALE_regrid' can be found in 'MOM_ALE.F90'. if ( CS%use_ALE_algorithm ) then call enable_averages(dtdia, Time_end_thermo, CS%diag) ! call pass_vector(u, v, G%Domain) @@ -1474,14 +1513,32 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & call check_redundant("Pre-ALE ", u, v, G) endif call cpu_clock_begin(id_clock_ALE) + + call pre_ALE_diagnostics(G, GV, US, h, u, v, tv, CS%ALE_CSp) + call ALE_update_regrid_weights(dtdia, CS%ALE_CSp) + ! Do any necessary adjustments ot the state prior to remapping. + call pre_ALE_adjustments(G, GV, US, h, tv, CS%tracer_Reg, CS%ALE_CSp, u, v) + ! Adjust the target grids for diagnostics, in case there have been thickness adjustments. + call diag_update_remap_grids(CS%diag) + if (use_ice_shelf) then - call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, & - dtdia, CS%frac_shelf_h) + call ALE_regrid(G, GV, US, h, h_new, dzRegrid, tv, CS%ALE_CSp, CS%frac_shelf_h, PCM_cell) else - call ALE_main(G, GV, US, h, u, v, tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, dtdia) + call ALE_regrid(G, GV, US, h, h_new, dzRegrid, tv, CS%ALE_CSp, PCM_cell=PCM_cell) endif - if (showCallTree) call callTree_waypoint("finished ALE_main (step_MOM_thermo)") + if (showCallTree) call callTree_waypoint("new grid generated") + ! Remap all variables from the old grid h onto the new grid h_new + call ALE_remap_tracers(CS%ALE_CSp, G, GV, h, h_new, CS%tracer_Reg, showCallTree, dtdia, PCM_cell) + call ALE_remap_velocities(CS%ALE_CSp, G, GV, h, h_new, u, v, CS%OBC, dzRegrid, showCallTree, dtdia) + + ! Replace the old grid with new one. All remapping must be done by this point in the code. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + if (showCallTree) call callTree_waypoint("finished ALE_regrid (step_MOM_thermo)") call cpu_clock_end(id_clock_ALE) endif ! endif for the block "if ( CS%use_ALE_algorithm )" @@ -1580,13 +1637,16 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS logical :: do_vertical !< If enough time has elapsed, do the diabatic tracer sources/sinks logical :: adv_converged !< True if all the horizontal fluxes have been used + real, allocatable, dimension(:,:,:) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: dzRegrid ! The change in grid interface positions due to regridding, + ! in the same units as thicknesses [H ~> m or kg m-2] real :: dt_offline ! The offline timestep for advection [T ~> s] real :: dt_offline_vertical ! The offline timestep for vertical fluxes and remapping [T ~> s] logical :: skip_diffusion type(time_type), pointer :: accumulated_time => NULL() type(time_type), pointer :: vertical_time => NULL() - integer :: is, ie, js, je, isd, ied, jsd, jed + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz ! 3D pointers real, dimension(:,:,:), pointer :: & @@ -1601,7 +1661,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Grid-related pointer assignments G => CS%G ; GV => CS%GV ; US => CS%US - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call cpu_clock_begin(id_clock_offline_tracer) @@ -1612,19 +1672,11 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call enable_averaging(time_interval, Time_end, CS%diag) ! Check to see if this is the first iteration of the offline interval - if (accumulated_time == real_to_time(0.0)) then - first_iter = .true. - else ! This is probably unnecessary but is used to guard against unwanted behavior - first_iter = .false. - endif + first_iter = (accumulated_time == real_to_time(0.0)) ! Check to see if vertical tracer functions should be done - if (first_iter .or. (accumulated_time >= vertical_time)) then - do_vertical = .true. - vertical_time = accumulated_time + real_to_time(US%T_to_s*dt_offline_vertical) - else - do_vertical = .false. - endif + do_vertical = (first_iter .or. (accumulated_time >= vertical_time)) + if (do_vertical) vertical_time = accumulated_time + real_to_time(US%T_to_s*dt_offline_vertical) ! Increment the amount of time elapsed since last read and check if it's time to roll around accumulated_time = accumulated_time + real_to_time(time_interval) @@ -1703,7 +1755,28 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run call cpu_clock_begin(id_clock_ALE) - call ALE_offline_tracer_final( G, GV, CS%h, CS%tv, h_end, CS%tracer_Reg, CS%ALE_CSp, CS%OBC) + + ! Do any necessary adjustments ot the state prior to remapping. + call pre_ALE_adjustments(G, GV, US, h_end, CS%tv, CS%tracer_Reg, CS%ALE_CSp) + + allocate(h_new(isd:ied, jsd:jed, nz), source=0.0) + allocate(dzRegrid(isd:ied, jsd:jed, nz+1), source=0.0) + + ! Generate the new grid based on the tracer grid at the end of the interval. + call ALE_regrid(G, GV, US, h_end, h_new, dzRegrid, CS%tv, CS%ALE_CSp) + + ! Remap the tracers from the previous tracer grid onto the new grid. The thicknesses that + ! are used are intended to ensure that in the case where transports don't quite conserve, + ! the offline layer thicknesses do not drift too far away from the online model. + call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, debug=CS%debug) + + ! Update the tracer grid. + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + CS%h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + deallocate(h_new, dzRegrid) + call cpu_clock_end(id_clock_ALE) call pass_var(CS%h, G%Domain) endif @@ -1813,12 +1886,16 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! This include declares and sets the variable "version". # include "version_variable.h" - integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB real :: dtbt ! If negative, this specifies the barotropic timestep as a fraction ! of the maximum stable value [nondim]. real, allocatable, dimension(:,:) :: eta ! free surface height or column mass [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: h_new ! Layer thicknesses after regridding [H ~> m or kg m-2] + real, allocatable, dimension(:,:,:) :: dzRegrid ! The change in grid interface positions due to regridding, + ! in the same units as thicknesses [H ~> m or kg m-2] + logical, allocatable, dimension(:,:,:) :: PCM_cell ! If true, PCM remapping should be used in a cell. type(group_pass_type) :: tmp_pass_uv_T_S_h, pass_uv_T_S_h real :: default_val ! default value for a parameter @@ -1948,10 +2025,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & default=.false.) CS%tv%T_is_conT = use_conT_absS ; CS%tv%S_is_absS = use_conT_absS call get_param(param_file, "MOM", "ADIABATIC", CS%adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is "//& - "true. This assumes that KD = KDML = 0.0 and that "//& - "there is no buoyancy forcing, but makes the model "//& - "faster by eliminating subroutine calls.", default=.false.) + "There are no diapycnal mass fluxes if ADIABATIC is true. "//& + "This assumes that KD = 0.0 and that there is no buoyancy forcing, "//& + "but makes the model faster by eliminating subroutine calls.", default=.false.) call get_param(param_file, "MOM", "DO_DYNAMICS", CS%do_dynamics, & "If False, skips the dynamics calls that update u & v, as well as "//& "the gravity wave adjustment to h. This may be a fragile feature, "//& @@ -1990,14 +2066,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & "The default is influenced by ENABLE_THERMODYNAMICS.", & default=use_temperature .and. .not.CS%use_ALE_algorithm) call get_param(param_file, "MOM", "THICKNESSDIFFUSE", CS%thickness_diffuse, & - "If true, interface heights are diffused with a "//& + "If true, isopycnal surfaces are diffused with a Laplacian "//& "coefficient of KHTH.", default=.false.) - call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", & - CS%thickness_diffuse_first, & - "If true, do thickness diffusion before dynamics. "//& - "This is only used if THICKNESSDIFFUSE is true.", & - default=.false.) - if (.not.CS%thickness_diffuse) CS%thickness_diffuse_first = .false. + call get_param(param_file, "MOM", "APPLY_INTERFACE_FILTER", CS%interface_filter, & + "If true, model interface heights are subjected to a grid-scale "//& + "dependent spatial smoothing, often with biharmonic filter.", default=.false.) + call get_param(param_file, "MOM", "THICKNESSDIFFUSE_FIRST", CS%thickness_diffuse_first, & + "If true, do thickness diffusion or interface height smoothing before dynamics. "//& + "This is only used if THICKNESSDIFFUSE or APPLY_INTERFACE_FILTER is true.", & + default=.false., do_not_log=.not.(CS%thickness_diffuse.or.CS%interface_filter)) + call get_param(param_file, "MOM", "USE_POROUS_BARRIER", CS%use_porbar, & + "If true, use porous barrier to constrain the widths "//& + "and face areas at the edges of the grid cells. ", & + default=.true.) ! The default should be false after tests. call get_param(param_file, "MOM", "BATHYMETRY_AT_VEL", bathy_at_vel, & "If true, there are separate values for the basin depths "//& "at velocity points. Otherwise the effects of topography "//& @@ -2478,12 +2559,11 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%time_in_cycle = 0.0 ; CS%time_in_thermo_cycle = 0.0 !allocate porous topography variables - ALLOC_(CS%por_face_areaU(IsdB:IedB,jsd:jed,nz)) ; CS%por_face_areaU(:,:,:) = 1.0 - ALLOC_(CS%por_face_areaV(isd:ied,JsdB:JedB,nz)) ; CS%por_face_areaV(:,:,:) = 1.0 - ALLOC_(CS%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1)) ; CS%por_layer_widthU(:,:,:) = 1.0 - ALLOC_(CS%por_layer_widthV(isd:ied,JsdB:JedB,nz+1)) ; CS%por_layer_widthV(:,:,:) = 1.0 - CS%pbv%por_face_areaU => CS%por_face_areaU; CS%pbv%por_face_areaV=> CS%por_face_areaV - CS%pbv%por_layer_widthU => CS%por_layer_widthU; CS%pbv%por_layer_widthV => CS%por_layer_widthV + allocate(CS%pbv%por_face_areaU(IsdB:IedB,jsd:jed,nz)) ; CS%pbv%por_face_areaU(:,:,:) = 1.0 + allocate(CS%pbv%por_face_areaV(isd:ied,JsdB:JedB,nz)) ; CS%pbv%por_face_areaV(:,:,:) = 1.0 + allocate(CS%pbv%por_layer_widthU(IsdB:IedB,jsd:jed,nz+1)) ; CS%pbv%por_layer_widthU(:,:,:) = 1.0 + allocate(CS%pbv%por_layer_widthV(isd:ied,JsdB:JedB,nz+1)) ; CS%pbv%por_layer_widthV(:,:,:) = 1.0 + ! Use the Wright equation of state by default, unless otherwise specified ! Note: this line and the following block ought to be in a separate ! initialization routine for tv. @@ -2738,14 +2818,30 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif call callTree_waypoint("Calling adjustGridForIntegrity() to remap initial conditions (initialize_MOM)") call adjustGridForIntegrity(CS%ALE_CSp, G, GV, CS%h ) - call callTree_waypoint("Calling ALE_main() to remap initial conditions (initialize_MOM)") + call pre_ALE_adjustments(G, GV, US, CS%h, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%u, CS%v) + + call callTree_waypoint("Calling ALE_regrid() to remap initial conditions (initialize_MOM)") + allocate(h_new(isd:ied, jsd:jed, nz), source=0.0) + allocate(dzRegrid(isd:ied, jsd:jed, nz+1), source=0.0) + allocate(PCM_cell(isd:ied, jsd:jed, nz), source=.false.) if (use_ice_shelf) then - call ALE_main(G, GV, US, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp, & - CS%OBC, frac_shelf_h=CS%frac_shelf_h) + call ALE_regrid(G, GV, US, CS%h, h_new, dzRegrid, CS%tv, CS%ALE_CSp, CS%frac_shelf_h, PCM_cell) else - call ALE_main( G, GV, US, CS%h, CS%u, CS%v, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC) + call ALE_regrid(G, GV, US, CS%h, h_new, dzRegrid, CS%tv, CS%ALE_CSp, PCM_cell=PCM_cell) endif + if (callTree_showQuery()) call callTree_waypoint("new grid generated") + ! Remap all variables from the old grid h onto the new grid h_new + call ALE_remap_tracers(CS%ALE_CSp, G, GV, CS%h, h_new, CS%tracer_Reg, CS%debug, PCM_cell=PCM_cell) + call ALE_remap_velocities(CS%ALE_CSp, G, GV, CS%h, h_new, CS%u, CS%v, CS%OBC, dzRegrid, debug=CS%debug) + + ! Replace the old grid with new one. All remapping must be done at this point. + !$OMP parallel do default(shared) + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + CS%h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + deallocate(h_new, dzRegrid, PCM_cell) + call cpu_clock_begin(id_clock_pass_init) call create_group_pass(tmp_pass_uv_T_S_h, CS%u, CS%v, G%Domain) if (use_temperature) then @@ -2759,6 +2855,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%debug) then call uvchksum("Post ALE adjust init cond [uv]", CS%u, CS%v, G%HI, haloshift=1) call hchksum(CS%h, "Post ALE adjust init cond h", G%HI, haloshift=1, scale=GV%H_to_m) + if (use_temperature) then + call hchksum(CS%tv%T, "Post ALE adjust init cond T", G%HI, haloshift=1, scale=US%C_to_degC) + call hchksum(CS%tv%S, "Post ALE adjust init cond S", G%HI, haloshift=1, scale=US%S_to_ppt) + endif endif endif if ( CS%use_ALE_algorithm ) call ALE_updateVerticalGridType( CS%ALE_CSp, GV ) @@ -2819,9 +2919,15 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call VarMix_init(Time, G, GV, US, param_file, diag, CS%VarMix) call set_visc_init(Time, G, GV, US, param_file, diag, CS%visc, CS%set_visc_CSp, restart_CSp, CS%OBC) call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) + if (CS%interface_filter) & + call interface_filter_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%interface_filter_CSp) new_sim = is_new_run(restart_CSp) call MOM_stoch_eos_init(G,Time,param_file,CS%stoch_eos_CS,restart_CSp,diag) + + if (CS%use_porbar) & + call porous_barriers_init(Time, US, param_file, diag, CS%por_bar_CS) + if (CS%split) then allocate(eta(SZI_(G),SZJ_(G)), source=0.0) call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & @@ -3143,6 +3249,8 @@ subroutine MOM_timing_init(CS) id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) if (CS%thickness_diffuse) & id_clock_thick_diff = cpu_clock_id('(Ocean thickness diffusion *)', grain=CLOCK_MODULE) + if (CS%interface_filter) & + id_clock_int_filter = cpu_clock_id('(Ocean interface height filter *)', grain=CLOCK_MODULE) !if (CS%mixedlayer_restrat) & id_clock_ml_restrat = cpu_clock_id('(Ocean mixed layer restrat)', grain=CLOCK_MODULE) id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) @@ -3775,8 +3883,8 @@ subroutine MOM_end(CS) if (CS%use_ALE_algorithm) call ALE_end(CS%ALE_CSp) !deallocate porous topography variables - DEALLOC_(CS%por_face_areaU) ; DEALLOC_(CS%por_face_areaV) - DEALLOC_(CS%por_layer_widthU) ; DEALLOC_(CS%por_layer_widthV) + deallocate(CS%pbv%por_face_areaU) ; deallocate(CS%pbv%por_face_areaV) + deallocate(CS%pbv%por_layer_widthU) ; deallocate(CS%pbv%por_layer_widthV) ! NOTE: Allocated in PressureForce_FV_Bouss if (associated(CS%tv%varT)) deallocate(CS%tv%varT) @@ -3809,6 +3917,7 @@ subroutine MOM_end(CS) endif call thickness_diffuse_end(CS%thickness_diffuse_CSp, CS%CDp) + if (CS%interface_filter) call interface_filter_end(CS%interface_filter_CSp, CS%CDp) call VarMix_end(CS%VarMix) call set_visc_end(CS%visc, CS%set_visc_CSp) call MEKE_end(CS%MEKE) diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 6aacc479af..3289786fd0 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -16,7 +16,7 @@ module MOM_CoriolisAdv use MOM_open_boundary, only : OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : accel_diag_ptrs, porous_barrier_ptrs +use MOM_variables, only : accel_diag_ptrs, porous_barrier_type use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_interface, only : wave_parameters_CS @@ -49,10 +49,10 @@ module MOM_CoriolisAdv real :: F_eff_max_blend !< The factor by which the maximum effective Coriolis !! acceleration from any point can be increased when !! blending different discretizations with the - !! ARAKAWA_LAMB_BLEND Coriolis scheme. This must be - !! greater than 2.0, and is 4.0 by default. + !! ARAKAWA_LAMB_BLEND Coriolis scheme [nondim]. + !! This must be greater than 2.0, and is 4.0 by default. real :: wt_lin_blend !< A weighting value beyond which the blending between - !! Sadourny and Arakawa & Hsu goes linearly to 0. + !! Sadourny and Arakawa & Hsu goes linearly to 0 [nondim]. !! This must be between 1 and 1e-15, often 1/8. logical :: no_slip !< If true, no slip boundary conditions are used. !! Otherwise free slip boundary conditions are assumed. @@ -140,7 +140,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav type(accel_diag_ptrs), intent(inout) :: AD !< Storage for acceleration diagnostics type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(CoriolisAdv_CS), intent(in) :: CS !< Control structure for MOM_CoriolisAdv - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics type(Wave_parameters_CS), optional, pointer :: Waves !< An optional pointer to Stokes drift CS ! Local variables @@ -173,9 +173,10 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav ! KEy = d/dy KE. vh_center ! Transport based on arithmetic mean h at v-points [H L2 T-1 ~> m3 s-1 or kg s-1] real, dimension(SZI_(G),SZJ_(G)) :: & - uh_min, uh_max, & ! The smallest and largest estimates of the volume - vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx) - ! [H L2 T-1 ~> m3 s-1 or kg s-1]. + uh_min, uh_max, & ! The smallest and largest estimates of the zonal volume fluxes through + ! the faces (i.e. u*h*dy) [H L2 T-1 ~> m3 s-1 or kg s-1] + vh_min, vh_max, & ! The smallest and largest estimates of the meridional volume fluxes through + ! the faces (i.e. v*h*dx) [H L2 T-1 ~> m3 s-1 or kg s-1] ep_u, ep_v ! Additional pseudo-Coriolis terms in the Arakawa and Lamb ! discretization [H-1 T-1 ~> m-1 s-1 or m2 kg-1 s-1]. real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -195,8 +196,8 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, US, CS, pbv, Wav real :: max_fv, max_fu ! The maximum or minimum of the neighboring Coriolis real :: min_fv, min_fu ! accelerations [L T-2 ~> m s-2], i.e. max(min)_fu(v)q. - real, parameter :: C1_12=1.0/12.0 ! C1_12 = 1/12 - real, parameter :: C1_24=1.0/24.0 ! C1_24 = 1/24 + real, parameter :: C1_12 = 1.0 / 12.0 ! C1_12 = 1/12 [nondim] + real, parameter :: C1_24 = 1.0 / 24.0 ! C1_24 = 1/24 [nondim] real :: max_Ihq, min_Ihq ! The maximum and minimum of the nearby Ihq [H-1 ~> m-1 or m2 kg-1]. real :: hArea_q ! The sum of area times thickness of the cells ! surrounding a q point [H L2 ~> m3 or kg]. diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index e700507290..a35effa5c0 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -103,10 +103,10 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - S_t, & ! Top and bottom edge values for linear reconstructions - S_b, & ! of salinity within each layer [S ~> ppt]. - T_t, & ! Top and bottom edge values for linear reconstructions - T_b ! of temperature within each layer [C ~> degC]. + S_t, S_b, & ! Top and bottom edge values for linear reconstructions + ! of salinity within each layer [S ~> ppt]. + T_t, T_b ! Top and bottom edge values for linear reconstructions + ! of temperature within each layer [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & dza, & ! The change in geopotential anomaly between the top and bottom ! of a layer [L2 T-2 ~> m2 s-2]. @@ -155,7 +155,7 @@ subroutine PressureForce_FV_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_ real :: H_to_RL2_T2 ! A factor to convert from thickness units (H) to pressure ! units [R L2 T-2 H-1 ~> Pa m-1 or Pa m2 kg-1]. ! real :: oneatm ! 1 standard atmosphere of pressure in [R L2 T-2 ~> Pa] - real, parameter :: C1_6 = 1.0/6.0 + real, parameter :: C1_6 = 1.0/6.0 ! [nondim] integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k @@ -472,10 +472,10 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm S_tmp ! Temporary array of salinities where layers that are lighter ! than the mixed layer have the mixed layer's properties [S ~> ppt]. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & - S_t, & ! Top and bottom edge values for linear reconstructions - S_b, & ! of salinity within each layer [S ~> ppt]. - T_t, & ! Top and bottom edge values for linear reconstructions - T_b ! of temperature within each layer [C ~> degC]. + S_t, S_b, & ! Top and bottom edge values for linear reconstructions + ! of salinity within each layer [S ~> ppt]. + T_t, T_b ! Top and bottom edge values for linear reconstructions + ! of temperature within each layer [C ~> degC]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & rho_pgf, rho_stanley_pgf ! Density [kg m-3] from EOS with and without SGS T variance ! in Stanley parameterization. @@ -497,7 +497,7 @@ subroutine PressureForce_FV_Bouss(h, tv, PFu, PFv, G, GV, US, CS, ALE_CSp, p_atm logical :: use_ALE ! If true, use an ALE pressure reconstruction. logical :: use_EOS ! If true, density is calculated from T & S using an equation of state. type(thermo_var_ptrs) :: tv_tmp! A structure of temporary T & S. - real, parameter :: C1_6 = 1.0/6.0 + real, parameter :: C1_6 = 1.0/6.0 ! [nondim] integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz, nkmb integer :: i, j, k diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index 003bd2c3ec..1ae4a8709a 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -122,7 +122,8 @@ subroutine PressureForce_Mont_nonBouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pb real :: I_gEarth ! The inverse of g_Earth [T2 Z L-2 ~> s2 m-1] ! real :: dalpha - real :: Pa_to_H ! A factor to convert from R L2 T-2 to the thickness units (H). + real :: Pa_to_H ! A factor to convert from R L2 T-2 to the thickness units (H) + ! [H T2 R-1 L-2 ~> m2 s2 kg-1 or s2 m-1]. real :: alpha_Lay(SZK_(GV)) ! The specific volume of each layer [R-1 ~> m3 kg-1]. real :: dalpha_int(SZK_(GV)+1) ! The change in specific volume across each ! interface [R-1 ~> m3 kg-1]. @@ -380,7 +381,7 @@ subroutine PressureForce_Mont_Bouss(h, tv, PFu, PFv, G, GV, US, CS, p_atm, pbce, M, & ! The Montgomery potential, M = (p/rho + gz) [L2 T-2 ~> m2 s-2]. rho_star ! In-situ density divided by the derivative with depth of the ! corrected e times (G_Earth/Rho0) [L2 Z-1 T-2 ~> m s-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height in m. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: e ! Interface height [Z ~> m]. ! e may be adjusted (with a nonlinear equation of state) so that ! its derivative compensates for the adiabatic compressibility ! in seawater, but e will still be close to the interface depth. diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 5a02f64240..0949d203ae 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -398,6 +398,10 @@ module MOM_barotropic character*(20), parameter :: BT_CONT_STRING = "FROM_BT_CONT" !>@} +!> A negligible parameter which avoids division by zero, but is too small to +!! modify physical values. +real, parameter :: subroundoff = 1e-30 + contains !> This subroutine time steps the barotropic equations explicitly. @@ -626,6 +630,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real :: visc_rem ! A work variable that may equal visc_rem_[uv] [nondim] real :: vel_prev ! The previous velocity [L T-1 ~> m s-1]. real :: dtbt ! The barotropic time step [T ~> s]. + real :: dtbt_diag ! The nominal barotropic time step used in hifreq diagnostics [T ~> s]. + ! dtbt_diag = dt/(nstep+nfilter) real :: bebt ! A copy of CS%bebt [nondim]. real :: be_proj ! The fractional amount by which velocities are projected ! when project_velocity is true [nondim]. For now be_proj is set @@ -676,22 +682,22 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, real, allocatable :: wt_vel(:) ! The raw or relative weights of each of the barotropic timesteps ! in determining the average velocities [nondim] real, allocatable :: wt_eta(:) ! The raw or relative weights of each of the barotropic timesteps - ! in determining the average the average of eta [nondim] + ! in determining the average eta [nondim] real, allocatable :: wt_accel(:) ! The raw or relative weights of each of the barotropic timesteps ! in determining the average accelerations [nondim] real, allocatable :: wt_trans(:) ! The raw or relative weights of each of the barotropic timesteps ! in determining the average transports [nondim] real, allocatable :: wt_accel2(:) ! A potentially un-normalized copy of wt_accel [nondim] real :: sum_wt_vel ! The sum of the raw weights used to find average velocities [nondim] - real :: sum_wt_eta ! The sum of the raw weights used to find average the average of eta [nondim] + real :: sum_wt_eta ! The sum of the raw weights used to find average eta [nondim] real :: sum_wt_accel ! The sum of the raw weights used to find average accelerations [nondim] real :: sum_wt_trans ! The sum of the raw weights used to find average transports [nondim] real :: I_sum_wt_vel ! The inverse of the sum of the raw weights used to find average velocities [nondim] - real :: I_sum_wt_eta ! The inverse of the sum of the raw weights used to find the average of eta [nondim] + real :: I_sum_wt_eta ! The inverse of the sum of the raw weights used to find eta [nondim] real :: I_sum_wt_accel ! The inverse of the sum of the raw weights used to find average accelerations [nondim] real :: I_sum_wt_trans ! The inverse of the sum of the raw weights used to find average transports [nondim] real :: dt_filt ! The half-width of the barotropic filter [T ~> s]. - real :: trans_wt1, trans_wt2 ! The weights used to compute ubt_trans and vbt_trans + real :: trans_wt1, trans_wt2 ! The weights used to compute ubt_trans and vbt_trans [nondim] integer :: nfilter logical :: apply_OBCs, apply_OBC_flather, apply_OBC_open @@ -1001,23 +1007,23 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP parallel do default(shared) private(visc_rem) do k=1,nz ; do j=js,je ; do I=is-1,ie - ! rem needs greater than visc_rem_u and 1-Instep/visc_rem_u. + ! rem needs to be greater than visc_rem_u and 1-Instep/visc_rem_u. ! The 0.5 below is just for safety. - if (visc_rem_u(I,j,k) <= 0.0) then ; visc_rem = 0.0 - elseif (visc_rem_u(I,j,k) >= 1.0) then ; visc_rem = 1.0 - elseif (visc_rem_u(I,j,k)**2 > visc_rem_u(I,j,k) - 0.5*Instep) then - visc_rem = visc_rem_u(I,j,k) - else ; visc_rem = 1.0 - 0.5*Instep/visc_rem_u(I,j,k) ; endif + ! NOTE: subroundoff is a neglible value used to prevent division by zero. + ! When 1-0.5*Instep/visc_rem exceeds visc_rem, the subroundoff is too small + ! to modify the significand. When visc_rem is small, the max() operators + ! select visc_rem or 0. So subroundoff cannot impact the final value. + visc_rem = min(visc_rem_u(I,j,k), 1.) + visc_rem = max(visc_rem, 1. - 0.5 * Instep / (visc_rem + subroundoff)) + visc_rem = max(visc_rem, 0.) wt_u(I,j,k) = CS%frhatu(I,j,k) * visc_rem enddo ; enddo ; enddo !$OMP parallel do default(shared) private(visc_rem) do k=1,nz ; do J=js-1,je ; do i=is,ie - ! rem needs greater than visc_rem_v and 1-Instep/visc_rem_v. - if (visc_rem_v(i,J,k) <= 0.0) then ; visc_rem = 0.0 - elseif (visc_rem_v(i,J,k) >= 1.0) then ; visc_rem = 1.0 - elseif (visc_rem_v(i,J,k)**2 > visc_rem_v(i,J,k) - 0.5*Instep) then - visc_rem = visc_rem_v(i,J,k) - else ; visc_rem = 1.0 - 0.5*Instep/visc_rem_v(i,J,k) ; endif + ! As above, rem must be greater than visc_rem_v and 1-Instep/visc_rem_v. + visc_rem = min(visc_rem_v(I,j,k), 1.) + visc_rem = max(visc_rem, 1. - 0.5 * Instep / (visc_rem + subroundoff)) + visc_rem = max(visc_rem, 0.) wt_v(i,J,k) = CS%frhatv(i,J,k) * visc_rem enddo ; enddo ; enddo @@ -1055,6 +1061,30 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, enddo ; enddo enddo + if (apply_OBCs) then + do n=1,OBC%number_of_segments + if (.not. OBC%segment(n)%on_pe) cycle + I = OBC%segment(n)%HI%IsdB ; J = OBC%segment(n)%HI%JsdB + if (OBC%segment(n)%is_N_or_S .and. (J >= Jsq-1) .and. (J <= Jeq+1)) then + do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + gtot_S(i,j+1) = gtot_S(i,j) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) + gtot_N(i,j) = gtot_N(i,j+1) + endif + enddo + elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then + do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + gtot_W(i+1,j) = gtot_W(i,j) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) + gtot_E(i,j) = gtot_E(i+1,j) + endif + enddo + endif + enddo + endif + if (CS%tides) then call tidal_forcing_sensitivity(G, CS%tides_CSp, det_de) if (CS%tidal_sal_bug) then @@ -1690,6 +1720,8 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, if (nstep+nfilter==0 ) call MOM_error(FATAL, & "btstep: number of barotropic step (nstep+nfilter) is 0") + dtbt_diag = dt/(nstep+nfilter) + ! Set up the normalized weights for the filtered velocity. sum_wt_vel = 0.0 ; sum_wt_eta = 0.0 ; sum_wt_accel = 0.0 ; sum_wt_trans = 0.0 allocate(wt_vel(nstep+nfilter)) ; allocate(wt_eta(nstep+nfilter)) @@ -2350,7 +2382,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, forces, pbce, !$OMP end parallel if (do_hifreq_output) then - time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt) + time_step_end = time_bt_start + real_to_time(n*US%T_to_s*dtbt_diag) call enable_averages(dtbt, time_step_end, CS%diag) if (CS%id_ubt_hifreq > 0) call post_data(CS%id_ubt_hifreq, ubt(IsdB:IedB,jsd:jed), CS%diag) if (CS%id_vbt_hifreq > 0) call post_data(CS%id_vbt_hifreq, vbt(isd:ied,JsdB:JedB), CS%diag) @@ -2881,7 +2913,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, integer, intent(in) :: halo !< The extra halo size to use here. real, intent(in) :: dtbt !< The time step [T ~> s]. real, intent(in) :: bebt !< The fractional weighting of the future velocity - !! in determining the transport. + !! in determining the transport [nondim] logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. logical, intent(in) :: integral_BT_cont !< If true, update the barotropic continuity @@ -4291,7 +4323,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, real :: mean_SL ! The mean sea level that is used along with the bathymetry to estimate the ! geometry when LINEARIZED_BT_CORIOLIS is true or BT_NONLIN_STRESS is false [Z ~> m]. real :: det_de ! The partial derivative due to self-attraction and loading of the reference - ! geopotential with the sea surface height when tides are enabled. + ! geopotential with the sea surface height when tides are enabled [nondim]. ! This is typically ~0.09 or less. real, allocatable :: lin_drag_h(:,:) ! A spatially varying linear drag coefficient at tracer points ! that acts on the barotropic flow [Z T-1 ~> m s-1]. @@ -4392,13 +4424,6 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, #else wd_halos(1) = bt_halo_sz; wd_halos(2) = bt_halo_sz #endif - call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), & - "The barotropic x-halo size that is actually used.", & - layoutParam=.true.) - call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), & - "The barotropic y-halo size that is actually used.", & - layoutParam=.true.) - call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", CS%Nonlinear_continuity, & "If true, use nonlinear transports in the barotropic "//& "continuity equation. This does not apply if "//& @@ -4472,7 +4497,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, "If true, the tidal self-attraction and loading anomaly in the barotropic "//& "solver has the wrong sign, replicating a long-standing bug with a scalar "//& "self-attraction and loading term or the SAL term from a previous simulation.", & - default=.true., do_not_log=(det_de==0.0)) + default=.false., do_not_log=(det_de==0.0)) call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the "//& "Sadourny (1975) energy conserving scheme, otherwise "//& @@ -4619,6 +4644,12 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, call MOM_mesg("barotropic_init: barotropic y-halo size increased.", 3) endif #endif + call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), & + "The barotropic x-halo size that is actually used.", & + layoutParam=.true.) + call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), & + "The barotropic y-halo size that is actually used.", & + layoutParam=.true.) CS%isdw = G%isc-wd_halos(1) ; CS%iedw = G%iec+wd_halos(1) CS%jsdw = G%jsc-wd_halos(2) ; CS%jedw = G%jec+wd_halos(2) @@ -4784,7 +4815,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, endif CS%id_PFu_bt = register_diag_field('ocean_model', 'PFuBT', diag%axesCu1, Time, & - 'Zonal Anomalous Barotropic Pressure Force Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) + 'Zonal Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_PFv_bt = register_diag_field('ocean_model', 'PFvBT', diag%axesCv1, Time, & 'Meridional Anomalous Barotropic Pressure Force Acceleration', 'm s-2', conversion=US%L_T2_to_m_s2) CS%id_Coru_bt = register_diag_field('ocean_model', 'CoruBT', diag%axesCu1, Time, & diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index 0852d10cd2..76e1bbc623 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -13,7 +13,7 @@ module MOM_continuity use MOM_grid, only : ocean_grid_type use MOM_open_boundary, only : ocean_OBC_type use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type, porous_barrier_ptrs +use MOM_variables, only : BT_cont_type, porous_barrier_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -61,7 +61,7 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, v type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_CS), intent(in) :: CS !< Control structure for mom_continuity. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The vertically summed volume !! flux through zonal faces [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -71,12 +71,12 @@ subroutine continuity(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhbt, v real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_u !< Both the fraction of !! zonal momentum that remains after a time-step of viscosity, and the fraction of a time-step's - !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. + !! worth of a barotropic acceleration that a layer experiences after viscosity is applied [nondim]. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(in) :: visc_rem_v !< Both the fraction of !! meridional momentum that remains after a time-step of viscosity, and the fraction of a time-step's - !! worth of a barotropic acceleration that a layer experiences after viscosity is applied. + !! worth of a barotropic acceleration that a layer experiences after viscosity is applied [nondim]. !! Non-dimensional between 0 (at the bottom) and 1 (far above the bottom). real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocities that diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 402a6921ae..54eecd20c3 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -11,7 +11,7 @@ module MOM_continuity_PPM use MOM_open_boundary, only : ocean_OBC_type, OBC_segment_type, OBC_NONE use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : BT_cont_type, porous_barrier_ptrs +use MOM_variables, only : BT_cont_type, porous_barrier_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -90,7 +90,7 @@ subroutine continuity_PPM(u, v, hin, h, uh, vh, dt, G, GV, US, CS, OBC, pbv, uhb type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(continuity_PPM_CS), intent(in) :: CS !< Module's control structure. type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. - type(porous_barrier_ptrs), intent(in) :: pbv !< pointers to porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< pointers to porous barrier fractional cell metrics real, dimension(SZIB_(G),SZJ_(G)), & optional, intent(in) :: uhbt !< The summed volume flux through zonal faces !! [H L2 T-1 ~> m3 s-1 or kg s-1]. @@ -240,7 +240,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), & optional, intent(out) :: u_cor !< The zonal velocities (u with a barotropic correction) - !! that give uhbt as the depth-integrated transport, m s-1. + !! that give uhbt as the depth-integrated transport [L T-1 ~> m s-1] type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that describe the !! effective open face areas as a function of barotropic flow. @@ -249,8 +249,8 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZIB_(G)) :: & du, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. - du_min_CFL, & ! Min/max limits on du correction - du_max_CFL, & ! to avoid CFL violations [L T-1 ~> m s-1] + du_min_CFL, & ! Lower limit on du correction to avoid CFL violations [L T-1 ~> m s-1] + du_max_CFL, & ! Upper limit on du correction to avoid CFL violations [L T-1 ~> m s-1] duhdu_tot_0, & ! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. uh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. visc_rem_max ! The column maximum of visc_rem [nondim]. @@ -259,7 +259,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, US, CS, LB, OBC, por_face_are visc_rem ! A 2-D copy of visc_rem_u or an array of 1's [nondim]. real, dimension(SZIB_(G)) :: FAuI ! A list of sums of zonal face areas [H L ~> m2 or kg m-1]. real :: FA_u ! A sum of zonal face areas [H L ~> m2 or kg m-1]. - real :: I_vrm ! 1.0 / visc_rem_max, nondim. + real :: I_vrm ! 1.0 / visc_rem_max [nondim] real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step [T-1 ~> s-1]. real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. @@ -537,7 +537,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & !! transport [H L2 T-1 ~> m3 s-1 or kg s-1]. real, dimension(SZIB_(G)), intent(inout) :: duhdu !< Partial derivative of uh !! with u [H L ~> m2 or kg m-1]. - real, intent(in) :: dt !< Time increment [T ~> s]. + real, intent(in) :: dt !< Time increment [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type integer, intent(in) :: j !< Spatial index. integer, intent(in) :: ish !< Start of index range. @@ -549,8 +549,7 @@ subroutine zonal_flux_layer(u, h, h_L, h_R, uh, duhdu, visc_rem, dt, G, US, j, & type(ocean_OBC_type), optional, pointer :: OBC !< Open boundaries control structure. ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] - real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + real :: curv_3 ! A measure of the thickness curvature over a grid length [H ~> m or kg m-2] real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. integer :: i integer :: l_seg @@ -639,8 +638,7 @@ subroutine zonal_face_thickness(u, h, h_L, h_R, h_u, dt, G, GV, US, LB, vol_CFL, ! Local variables real :: CFL ! The CFL number based on the local velocity and grid spacing [nondim] - real :: curv_3 ! A measure of the thickness curvature over a grid length, - ! with the same units as h_in. + real :: curv_3 ! A measure of the thickness curvature over a grid length [H ~> m or kg m-2] real :: h_avg ! The average thickness of a flux [H ~> m or kg m-2]. real :: h_marg ! The marginal thickness of a flux [H ~> m or kg m-2]. logical :: local_open_BC @@ -772,10 +770,10 @@ subroutine zonal_flux_adjust(u, h_in, h_L, h_R, uhbt, uh_tot_0, duhdu_tot_0, & uh_err_best, & ! The smallest value of uh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. u_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. duhdu_tot,&! Summed partial derivative of uh with u [H L ~> m2 or kg m-1]. - du_min, & ! Min/max limits on du correction based on CFL limits - du_max ! and previous iterations [L T-1 ~> m s-1]. + du_min, & ! Lower limit on du correction based on CFL limits and previous iterations [L T-1 ~> m s-1] + du_max ! Upper limit on du correction based on CFL limits and previous iterations [L T-1 ~> m s-1] real :: du_prev ! The previous value of du [L T-1 ~> m s-1]. - real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. + real :: ddu ! The change in du from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. real :: tol_vel ! The tolerance for velocity in the current iteration [L T-1 ~> m s-1]. integer :: i, k, nz, itt, max_itts = 20 @@ -915,7 +913,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, du0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. duL, duR, & ! The barotropic velocity increments that give the westerly ! (duL) and easterly (duR) test velocities [L T-1 ~> m s-1]. - zeros, & ! An array of full of 0's. + zeros, & ! An array of full of 0 transports [H L2 T-1 ~> m3 s-1 or kg s-1] du_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. u_L, u_R, & ! The westerly (u_L), easterly (u_R), and zero-barotropic u_0, & ! transport (u_0) layer test velocities [L T-1 ~> m s-1]. @@ -936,7 +934,7 @@ subroutine set_zonal_BT_cont(u, h_in, h_L, h_R, BT_cont, uh_tot_0, duhdu_tot_0, ! from leading to large CFL numbers. real :: min_visc_rem ! The smallest permitted value for visc_rem that is used ! in finding the barotropic velocity that changes the - ! flow direction. This is necessary to keep the inverse + ! flow direction [nondim]. This is necessary to keep the inverse ! of visc_rem from leading to large CFL numbers. real :: CFL_min ! A minimal increment in the CFL to try to ensure that the ! flow is truly upwind [nondim] @@ -1076,17 +1074,17 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, US, CS, LB, OBC, por_fac h_L, h_R ! Left and right face thicknesses [H ~> m or kg m-2]. real, dimension(SZI_(G)) :: & dv, & ! Corrective barotropic change in the velocity [L T-1 ~> m s-1]. - dv_min_CFL, & ! Min/max limits on dv correction - dv_max_CFL, & ! to avoid CFL violations + dv_min_CFL, & ! Lower limit on dv correction to avoid CFL violations [L T-1 ~> m s-1] + dv_max_CFL, & ! Upper limit on dv correction to avoid CFL violations [L T-1 ~> m s-1] dvhdv_tot_0, & ! Summed partial derivative of vh with v [H L ~> m2 or kg m-1]. vh_tot_0, & ! Summed transport with no barotropic correction [H L2 T-1 ~> m3 s-1 or kg s-1]. - visc_rem_max ! The column maximum of visc_rem. + visc_rem_max ! The column maximum of visc_rem [nondim] logical, dimension(SZI_(G)) :: do_I real, dimension(SZI_(G)) :: FAvi ! A list of sums of meridional face areas [H L ~> m2 or kg m-1]. real :: FA_v ! A sum of meridional face areas [H L ~> m2 or kg m-1]. real, dimension(SZI_(G),SZK_(GV)) :: & - visc_rem ! A 2-D copy of visc_rem_v or an array of 1's. - real :: I_vrm ! 1.0 / visc_rem_max, nondim. + visc_rem ! A 2-D copy of visc_rem_v or an array of 1's [nondim] + real :: I_vrm ! 1.0 / visc_rem_max [nondim] real :: CFL_dt ! The maximum CFL ratio of the adjusted velocities divided by ! the time step [T-1 ~> s-1]. real :: I_dt ! 1.0 / dt [T-1 ~> s-1]. @@ -1598,8 +1596,8 @@ subroutine meridional_flux_adjust(v, h_in, h_L, h_R, vhbt, vh_tot_0, dvhdv_tot_0 vh_err_best, & ! The smallest value of vh_err found so far [H L2 T-1 ~> m3 s-1 or kg s-1]. v_new, & ! The velocity with the correction added [L T-1 ~> m s-1]. dvhdv_tot,&! Summed partial derivative of vh with u [H L ~> m2 or kg m-1]. - dv_min, & ! Min/max limits on dv correction based on CFL limits - dv_max ! and previous iterations [L T-1 ~> m s-1]. + dv_min, & ! Lower limit on dv correction based on CFL limits and previous iterations [L T-1 ~> m s-1] + dv_max ! Upper limit on dv correction based on CFL limits and previous iterations [L T-1 ~> m s-1] real :: dv_prev ! The previous value of dv [L T-1 ~> m s-1]. real :: ddv ! The change in dv from the previous iteration [L T-1 ~> m s-1]. real :: tol_eta ! The tolerance for the current iteration [H ~> m or kg m-2]. @@ -1741,7 +1739,7 @@ subroutine set_merid_BT_cont(v, h_in, h_L, h_R, BT_cont, vh_tot_0, dvhdv_tot_0, dv0, & ! The barotropic velocity increment that gives 0 transport [L T-1 ~> m s-1]. dvL, dvR, & ! The barotropic velocity increments that give the southerly ! (dvL) and northerly (dvR) test velocities [L T-1 ~> m s-1]. - zeros, & ! An array of full of 0's. + zeros, & ! An array of full of 0 transports [H L2 T-1 ~> m3 s-1 or kg s-1] dv_CFL, & ! The velocity increment that corresponds to CFL_min [L T-1 ~> m s-1]. v_L, v_R, & ! The southerly (v_L), northerly (v_R), and zero-barotropic v_0, & ! transport (v_0) layer test velocities [L T-1 ~> m s-1]. @@ -1871,7 +1869,7 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ !! [H ~> m or kg m-2]. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness - !! that can be obtained by a concave parabolic fit. + !! that can be obtained by a concave parabolic fit [H ~> m or kg m-2] logical, intent(in) :: monotonic !< If true, use the !! Colella & Woodward monotonic limiter. !! Otherwise use a simple positive-definite limiter. @@ -1881,8 +1879,8 @@ subroutine PPM_reconstruction_x(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes per grid point [H ~> m or kg m-2] + real, parameter :: oneSixth = 1./6. ! [nondim] real :: h_ip1, h_im1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] @@ -2007,7 +2005,7 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ !! [H ~> m or kg m-2]. type(loop_bounds_type), intent(in) :: LB !< Active loop bounds structure. real, intent(in) :: h_min !< The minimum thickness - !! that can be obtained by a concave parabolic fit. + !! that can be obtained by a concave parabolic fit [H ~> m or kg m-2] logical, intent(in) :: monotonic !< If true, use the !! Colella & Woodward monotonic limiter. !! Otherwise use a simple positive-definite limiter. @@ -2017,8 +2015,8 @@ subroutine PPM_reconstruction_y(h_in, h_L, h_R, G, LB, h_min, monotonic, simple_ type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables with useful mnemonic names. - real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes. - real, parameter :: oneSixth = 1./6. + real, dimension(SZI_(G),SZJ_(G)) :: slp ! The slopes per grid point [H ~> m or kg m-2] + real, parameter :: oneSixth = 1./6. ! [nondim] real :: h_jp1, h_jm1 ! Neighboring thicknesses or sensibly extrapolated values [H ~> m or kg m-2] real :: dMx, dMn ! The difference between the local thickness and the maximum (dMx) or ! minimum (dMn) of the surrounding values [H ~> m or kg m-2] @@ -2141,7 +2139,7 @@ subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left thickness in the reconstruction [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right thickness in the reconstruction [H ~> m or kg m-2]. real, intent(in) :: h_min !< The minimum thickness - !! that can be obtained by a concave parabolic fit. + !! that can be obtained by a concave parabolic fit [H ~> m or kg m-2] integer, intent(in) :: iis !< Start of i index range. integer, intent(in) :: iie !< End of i index range. integer, intent(in) :: jis !< Start of j index range. @@ -2218,10 +2216,10 @@ end subroutine PPM_limit_CW84 !> Return the maximum ratio of a/b or maxrat. function ratio_max(a, b, maxrat) result(ratio) - real, intent(in) :: a !< Numerator - real, intent(in) :: b !< Denominator - real, intent(in) :: maxrat !< Maximum value of ratio. - real :: ratio !< Return value. + real, intent(in) :: a !< Numerator, in arbitrary units [A] + real, intent(in) :: b !< Denominator, in arbitrary units [B] + real, intent(in) :: maxrat !< Maximum value of ratio [A B-1] + real :: ratio !< Return value [A B-1] if (abs(a) > abs(maxrat*b)) then ratio = maxrat diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index c011d18c44..68f8c97669 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -3,7 +3,7 @@ module MOM_dynamics_split_RK2 ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_type use MOM_variables, only : BT_cont_type, alloc_bt_cont_type, dealloc_bt_cont_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing @@ -21,16 +21,17 @@ module MOM_dynamics_split_RK2 use MOM_domains, only : To_South, To_West, To_All, CGRID_NE, SCALAR_PAIR use MOM_domains, only : To_North, To_East, Omit_Corners use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type -use MOM_domains, only : start_group_pass, complete_group_pass, pass_var +use MOM_domains, only : start_group_pass, complete_group_pass, pass_var, pass_vector use MOM_debugging, only : hchksum, uvchksum use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_get_input, only : directories -use MOM_io, only : vardesc, var_desc +use MOM_io, only : vardesc, var_desc, EAST_FACE, NORTH_FACE use MOM_restart, only : register_restart_field, register_restart_pair use MOM_restart, only : query_initialized, set_initialized, save_restart +use MOM_restart, only : only_read_from_restarts use MOM_restart, only : restart_init, is_new_run, MOM_restart_CS use MOM_time_manager, only : time_type, time_type_to_real, operator(+) use MOM_time_manager, only : operator(-), operator(>), operator(*), operator(/) @@ -77,12 +78,14 @@ module MOM_dynamics_split_RK2 type, public :: MOM_dyn_split_RK2_CS ; private real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: & CAu, & !< CAu = f*v - u.grad(u) [L T-2 ~> m s-2] + CAu_pred, & !< The predictor step value of CAu = f*v - u.grad(u) [L T-2 ~> m s-2] PFu, & !< PFu = -dM/dx [L T-2 ~> m s-2] PFu_Stokes, & !< PFu_Stokes = -d/dx int_r (u_L*duS/dr) [L T-2 ~> m s-2] diffu !< Zonal acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: & CAv, & !< CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] + CAv_pred, & !< The predictor step value of CAv = -f*u - u.grad(v) [L T-2 ~> m s-2] PFv, & !< PFv = -dM/dy [L T-2 ~> m s-2] PFv_Stokes, & !< PFv_Stokes = -d/dy int_r (v_L*dvS/dr) [L T-2 ~> m s-2] diffv !< Meridional acceleration due to convergence of the along-isopycnal stress tensor [L T-2 ~> m s-2] @@ -91,7 +94,7 @@ module MOM_dynamics_split_RK2 !< Both the fraction of the zonal momentum originally in a !! layer that remains after a time-step of viscosity, and the !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. + !! that a layer experiences after viscosity is applied [nondim]. !! Nondimensional between 0 (at the bottom) and 1 (far above). real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: u_accel_bt !< The zonal layer accelerations due to the difference between @@ -101,7 +104,7 @@ module MOM_dynamics_split_RK2 !< Both the fraction of the meridional momentum originally in !! a layer that remains after a time-step of viscosity, and the !! fraction of a time-step worth of a barotropic acceleration - !! that a layer experiences after viscosity is applied. + !! that a layer experiences after viscosity is applied [nondim]. !! Nondimensional between 0 (at the bottom) and 1 (far above). real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: v_accel_bt !< The meridional layer accelerations due to the difference between @@ -150,6 +153,13 @@ module MOM_dynamics_split_RK2 !! barotropic solver. logical :: calc_dtbt !< If true, calculate the barotropic time-step !! dynamically. + logical :: store_CAu !< If true, store the Coriolis and advective accelerations at the + !! end of the timestep for use in the next predictor step. + logical :: CAu_pred_stored !< If true, the Coriolis and advective accelerations at the + !! end of the timestep have been stored for use in the next + !! predictor step. This is used to accomodate various generations + !! of restart files. + logical :: use_tides !< If true, tidal forcing is enabled. real :: be !< A nondimensional number from 0.5 to 1 that controls !! the backward weighting of the time stepping scheme [nondim] @@ -191,13 +201,16 @@ module MOM_dynamics_split_RK2 integer :: id_u_BT_accel_visc_rem = -1, id_v_BT_accel_visc_rem = -1 !>@} - type(diag_ctrl), pointer :: diag !< A structure that is used to regulate the + type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to regulate the !! timing of diagnostic output. - type(accel_diag_ptrs), pointer :: ADp !< A structure pointing to the various + type(accel_diag_ptrs), pointer :: ADp => NULL() !< A structure pointing to the various !! accelerations in the momentum equations, !! which can later be used to calculate !! derived diagnostics like energy budgets. - type(cont_diag_ptrs), pointer :: CDp !< A structure with pointers to various + type(accel_diag_ptrs), pointer :: AD_pred => NULL() !< A structure pointing to the various + !! predictor step accelerations in the momentum equations, + !! which can be used to debug truncations. + type(cont_diag_ptrs), pointer :: CDp => NULL() !< A structure with pointers to various !! terms in the continuity equations, !! which can later be used to calculate !! derived diagnostics like energy budgets. @@ -297,35 +310,37 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s type(MEKE_type), intent(inout) :: MEKE !< MEKE fields type(thickness_diffuse_CS), intent(inout) :: thickness_diffuse_CSp !< Pointer to a structure containing !! interface height diffusivities - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions ! local variables real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: up ! Predicted zonal velocity [L T-1 ~> m s-1]. real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: vp ! Predicted meridional velocity [L T-1 ~> m s-1]. - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted thickness [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted thickness [H ~> m or kg m-2]. real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: ueffA ! Effective Area of U-Faces [H L ~> m2] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: veffA ! Effective Area of V-Faces [H L ~> m2] - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_bc_accel - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_bc_accel - ! u_bc_accel and v_bc_accel are the summed baroclinic accelerations of each - ! layer calculated by the non-barotropic part of the model [L T-2 ~> m s-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), target :: uh_in - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), target :: vh_in - ! uh_in and vh_in are the zonal or meridional mass transports that would be - ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1]. - - real, dimension(SZI_(G),SZJ_(G)) :: eta_pred - real, dimension(SZI_(G),SZJ_(G)) :: deta_dt - ! eta_pred is the predictor value of the free surface height or column mass, - ! [H ~> m or kg m-2]. - - real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_old_rad_OBC - real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_old_rad_OBC - ! u_old_rad_OBC and v_old_rad_OBC are the starting velocities, which are - ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1]. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_bc_accel ! The summed zonal baroclinic accelerations + ! of each layer calculated by the non-barotropic + ! part of the model [L T-2 ~> m s-2] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_bc_accel ! The summed meridional baroclinic accelerations + ! of each layer calculated by the non-barotropic + ! part of the model [L T-2 ~> m s-2] + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), target :: uh_in ! The zonal mass transports that would be + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), target :: vh_in ! The meridional mass transports that would be + ! obtained using the initial velocities [H L2 T-1 ~> m3 s-1 or kg s-1] + + real, dimension(SZI_(G),SZJ_(G)) :: eta_pred ! The predictor value of the free surface height + ! or column mass [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)) :: deta_dt ! A diagnostic of the time derivative of the free surface + ! height or column mass [H T-1 ~> m s-1 or kg m-2 s-1] + + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: u_old_rad_OBC ! The starting zonal velocities, which are + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: v_old_rad_OBC ! The starting meridional velocities, which are + ! saved for use in the Flather open boundary condition code [L T-1 ~> m s-1] real :: pres_to_eta ! A factor that converts pressures to the units of eta ! [H T2 R-1 L-2 ~> m Pa-1 or kg m-2 Pa-1] @@ -351,7 +366,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s h_av ! The layer thickness time-averaged over a time step [H ~> m or kg m-2]. real :: dt_pred ! The time step for the predictor part of the baroclinic time stepping [T ~> s]. - real :: Idt_bc ! Inverse of the baroclinic timestep + real :: Idt_bc ! Inverse of the baroclinic timestep [T-1 ~> s-1] logical :: dyn_p_surf logical :: BT_cont_BT_thick ! If true, use the BT_cont_type to estimate the @@ -368,9 +383,9 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB u_av => CS%u_av ; v_av => CS%v_av ; h_av => CS%h_av ; eta => CS%eta - Idt_bc = 1./dt + Idt_bc = 1.0 / dt - sym=.false.;if (G%Domain%symmetric) sym=.true. ! switch to include symmetric domain in checksums + sym = G%Domain%symmetric ! switch to include symmetric domain in checksums showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("step_MOM_dyn_split_RK2(), MOM_dynamics_split_RK2.F90") @@ -494,21 +509,25 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call start_group_pass(CS%pass_eta, G%Domain, clock=id_clock_pass) ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av - call cpu_clock_begin(id_clock_Cor) - call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu, CS%CAv, CS%OBC, CS%ADp, & - G, Gv, US, CS%CoriolisAdv, pbv, Waves=Waves) - call cpu_clock_end(id_clock_Cor) - if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + if (.not.CS%CAu_pred_stored) then + ! Calculate a predictor-step estimate of the Coriolis and momentum advection terms, + ! if it was not already stored from the end of the previous time step. + call cpu_clock_begin(id_clock_Cor) + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu_pred, CS%CAv_pred, CS%OBC, CS%AD_pred, & + G, GV, US, CS%CoriolisAdv, pbv, Waves=Waves) + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + endif ! u_bc_accel = CAu + PFu + diffu(u[n-1]) call cpu_clock_begin(id_clock_btforce) !$OMP parallel do default(shared) do k=1,nz do j=js,je ; do I=Isq,Ieq - u_bc_accel(I,j,k) = (CS%CAu(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) + u_bc_accel(I,j,k) = (CS%CAu_pred(I,j,k) + CS%PFu(I,j,k)) + CS%diffu(I,j,k) enddo ; enddo do J=Jsq,Jeq ; do i=is,ie - v_bc_accel(i,J,k) = (CS%CAv(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) + v_bc_accel(i,J,k) = (CS%CAv_pred(i,J,k) + CS%PFv(i,J,k)) + CS%diffv(i,J,k) enddo ; enddo enddo if (associated(CS%OBC)) then @@ -517,10 +536,10 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call cpu_clock_end(id_clock_btforce) if (CS%debug) then - call MOM_accel_chksum("pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + call MOM_accel_chksum("pre-btstep accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) + call check_redundant("pre-btstep CS%CA ", CS%CAu_pred, CS%CAv_pred, G) call check_redundant("pre-btstep CS%PF ", CS%PFu, CS%PFv, G) call check_redundant("pre-btstep CS%diff ", CS%diffu, CS%diffv, G) call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) @@ -591,6 +610,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s if (calc_dtbt) call set_dtbt(G, GV, US, CS%barotropic_CSp, eta, CS%pbce) if (showCallTree) call callTree_enter("btstep(), MOM_barotropic.F90") ! This is the predictor step call to btstep. + ! The CS%ADp argument here stores the weights for certain integrated diagnostics. call btstep(u, v, eta, dt, u_bc_accel, v_bc_accel, forces, CS%pbce, CS%eta_PF, u_av, v_av, & CS%u_accel_bt, CS%v_accel_bt, eta_pred, CS%uhbt, CS%vhbt, G, GV, US, & CS%barotropic_CSp, CS%visc_rem_u, CS%visc_rem_v, CS%ADp, CS%OBC, CS%BT_cont, & @@ -621,7 +641,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call uvchksum("Predictor 1 [uv]h", uh, vh, G%HI,haloshift=2, & symmetric=sym, scale=GV%H_to_m*US%L_to_m**2*US%s_to_T) ! call MOM_state_chksum("Predictor 1", up, vp, h, uh, vh, G, GV, US, haloshift=1) - call MOM_accel_chksum("Predictor accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & + call MOM_accel_chksum("Predictor accel", CS%CAu_pred, CS%CAv_pred, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, CS%u_accel_bt, CS%v_accel_bt, symmetric=sym) call MOM_state_chksum("Predictor 1 init", u, v, h, uh, vh, G, GV, US, haloshift=2, & symmetric=sym) @@ -637,7 +657,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif call vertvisc_coef(up, vp, h, forces, visc, dt_pred, G, GV, US, CS%vertvisc_CSp, & CS%OBC) - call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%ADp, CS%CDp, G, & + call vertvisc(up, vp, h, forces, visc, dt_pred, CS%OBC, CS%AD_pred, CS%CDp, G, & GV, US, CS%vertvisc_CSp, CS%taux_bot, CS%tauy_bot, waves=waves) if (showCallTree) call callTree_wayPoint("done with vertvisc (step_MOM_dyn_split_RK2)") if (G%nonblocking_updates) then @@ -796,7 +816,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s call MOM_accel_chksum("corr pre-btstep accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv, & CS%diffu, CS%diffv, G, GV, US, CS%pbce, u_bc_accel, v_bc_accel, & symmetric=sym) - call check_redundant("corr pre-btstep CS%Ca ", CS%Cau, CS%Cav, G) + call check_redundant("corr pre-btstep CS%CA ", CS%CAu, CS%CAv, G) call check_redundant("corr pre-btstep CS%PF ", CS%PFu, CS%PFv, G) call check_redundant("corr pre-btstep CS%diff ", CS%diffu, CS%diffv, G) call check_redundant("corr pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) @@ -923,6 +943,23 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s enddo ; enddo enddo + if (CS%store_CAu) then + ! Calculate a predictor-step estimate of the Coriolis and momentum advection terms + ! for use in the next time step, possibly after it has been vertically remapped. + call cpu_clock_begin(id_clock_Cor) + call disable_averaging(CS%diag) ! These calculations should not be used for diagnostics. + ! CAu = -(f+zeta_av)/h_av vh + d/dx KE_av + call CorAdCalc(u_av, v_av, h_av, uh, vh, CS%CAu_pred, CS%CAv_pred, CS%OBC, CS%AD_pred, & + G, GV, US, CS%CoriolisAdv, pbv, Waves=Waves) + CS%CAu_pred_stored = .true. + call enable_averages(dt, Time_local, CS%diag) ! Reenable the averaging + call cpu_clock_end(id_clock_Cor) + if (showCallTree) call callTree_wayPoint("done with CorAdCalc (step_MOM_dyn_split_RK2)") + else + CS%CAu_pred_stored = .false. + endif + + ! The time-averaged free surface height has already been set by the last call to btstep. ! Deallocate this memory to avoid a memory leak. ### We should revisit how this array is declared. -RWH @@ -1045,8 +1082,9 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & target, intent(inout) :: vh !< merid volume or mass transport [H L2 T-1 ~> m3 s-1 or kg s-1] - type(vardesc) :: vd(2) - character(len=48) :: thickness_units, flux_units + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. + type(vardesc) :: vd(2) + character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -1065,6 +1103,8 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C ALLOC_(CS%diffv(isd:ied,JsdB:JedB,nz)) ; CS%diffv(:,:,:) = 0.0 ALLOC_(CS%CAu(IsdB:IedB,jsd:jed,nz)) ; CS%CAu(:,:,:) = 0.0 ALLOC_(CS%CAv(isd:ied,JsdB:JedB,nz)) ; CS%CAv(:,:,:) = 0.0 + ALLOC_(CS%CAu_pred(IsdB:IedB,jsd:jed,nz)) ; CS%CAu_pred(:,:,:) = 0.0 + ALLOC_(CS%CAv_pred(isd:ied,JsdB:JedB,nz)) ; CS%CAv_pred(:,:,:) = 0.0 ALLOC_(CS%PFu(IsdB:IedB,jsd:jed,nz)) ; CS%PFu(:,:,:) = 0.0 ALLOC_(CS%PFv(isd:ied,JsdB:JedB,nz)) ; CS%PFv(:,:,:) = 0.0 @@ -1076,6 +1116,11 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C thickness_units = get_thickness_units(GV) flux_units = get_flux_units(GV) + call get_param(param_file, mdl, "STORE_CORIOLIS_ACCEL", CS%store_CAu, & + "If true, calculate the Coriolis accelerations at the end of each "//& + "timestep for use in the predictor step of the next split RK2 timestep.", & + default=.true., do_not_log=.true.) + if (GV%Boussinesq) then call register_restart_field(CS%eta, "sfc", .false., restart_CS, & longname="Free surface Height", units=thickness_units, conversion=GV%H_to_mks) @@ -1084,18 +1129,27 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, US, param_file, CS, restart_C longname="Bottom Pressure", units=thickness_units, conversion=GV%H_to_mks) endif + ! These are needed, either to calculate CAu and CAv or to calculate the velocity anomalies in + ! the barotropic solver's Coriolis terms. vd(1) = var_desc("u2", "m s-1", "Auxiliary Zonal velocity", 'u', 'L') vd(2) = var_desc("v2", "m s-1", "Auxiliary Meridional velocity", 'v', 'L') call register_restart_pair(CS%u_av, CS%v_av, vd(1), vd(2), .false., restart_CS, & conversion=US%L_T_to_m_s) - call register_restart_field(CS%h_av, "h2", .false., restart_CS, & + if (CS%store_CAu) then + vd(1) = var_desc("CAu", "m s-2", "Zonal Coriolis and advactive acceleration", 'u', 'L') + vd(2) = var_desc("CAv", "m s-2", "Meridional Coriolis and advactive acceleration", 'v', 'L') + call register_restart_pair(CS%CAu_pred, CS%CAv_pred, vd(1), vd(2), .false., restart_CS, & + conversion=US%L_T2_to_m_s2) + else + call register_restart_field(CS%h_av, "h2", .false., restart_CS, & longname="Auxiliary Layer Thickness", units=thickness_units, conversion=GV%H_to_mks) - vd(1) = var_desc("uh", flux_units, "Zonal thickness flux", 'u', 'L') - vd(2) = var_desc("vh", flux_units, "Meridional thickness flux", 'v', 'L') - call register_restart_pair(uh, vh, vd(1), vd(2), .false., restart_CS, & - conversion=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) + vd(1) = var_desc("uh", flux_units, "Zonal thickness flux", 'u', 'L') + vd(2) = var_desc("vh", flux_units, "Meridional thickness flux", 'v', 'L') + call register_restart_pair(uh, vh, vd(1), vd(2), .false., restart_CS, & + conversion=GV%H_to_MKS*US%L_to_m**2*US%s_to_T) + endif vd(1) = var_desc("diffu", "m s-2", "Zonal horizontal viscous acceleration", 'u', 'L') vd(2) = var_desc("diffv", "m s-2", "Meridional horizontal viscous acceleration", 'v', 'L') @@ -1152,7 +1206,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param !! the number of times the velocity is !! truncated (this should be 0). logical, intent(out) :: calc_dtbt !< If true, recalculate the barotropic time step - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics integer, intent(out) :: cont_stencil !< The stencil for thickness !! from the continuity solver. @@ -1171,7 +1225,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param real :: accel_rescale ! A rescaling factor for accelerations from the representation in a ! restart file to the internal representation in this run [various units ~> 1] type(group_pass_type) :: pass_av_h_uvh - logical :: use_tides, debug_truncations + logical :: debug_truncations + logical :: read_uv, read_h2 integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -1191,7 +1246,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param CS%diag => diag call log_version(param_file, mdl, version, "") - call get_param(param_file, mdl, "TIDES", use_tides, & + call get_param(param_file, mdl, "TIDES", CS%use_tides, & "If true, apply tidal momentum forcing.", default=.false.) call get_param(param_file, mdl, "BE", CS%be, & "If SPLIT is true, BE determines the relative weighting "//& @@ -1217,6 +1272,10 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param "If true, use the summed layered fluxes plus an "//& "adjustment due to the change in the barotropic velocity "//& "in the barotropic continuity equation.", default=.true.) + call get_param(param_file, mdl, "STORE_CORIOLIS_ACCEL", CS%store_CAu, & + "If true, calculate the Coriolis accelerations at the end of each "//& + "timestep for use in the predictor step of the next split RK2 timestep.", & + default=.true.) call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", & default=.false., debuggingParam=.true.) @@ -1262,6 +1321,15 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param Accel_diag%u_accel_bt => CS%u_accel_bt Accel_diag%v_accel_bt => CS%v_accel_bt + allocate(CS%AD_pred) + CS%AD_pred%diffu => CS%diffu + CS%AD_pred%diffv => CS%diffv + CS%AD_pred%PFu => CS%PFu + CS%AD_pred%PFv => CS%PFv + CS%AD_pred%CAu => CS%CAu_pred + CS%AD_pred%CAv => CS%CAv_pred + CS%AD_pred%u_accel_bt => CS%u_accel_bt + CS%AD_pred%v_accel_bt => CS%v_accel_bt ! Accel_diag%pbce => CS%pbce ! Accel_diag%u_accel_bt => CS%u_accel_bt ; Accel_diag%v_accel_bt => CS%v_accel_bt @@ -1273,7 +1341,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call continuity_init(Time, G, GV, US, param_file, diag, CS%continuity_CSp) cont_stencil = continuity_stencil(CS%continuity_CSp) call CoriolisAdv_init(Time, G, GV, US, param_file, diag, CS%ADp, CS%CoriolisAdv) - if (use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) + if (CS%use_tides) call tidal_forcing_init(Time, G, US, param_file, CS%tides_CSp) call PressureForce_init(Time, G, GV, US, param_file, diag, CS%PressureForce_CSp, & CS%tides_CSp) call hor_visc_init(Time, G, GV, US, param_file, diag, CS%hor_visc, ADp=CS%ADp) @@ -1348,38 +1416,77 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied ; CS%v_av(i,J,k) = vel_rescale * CS%v_av(i,J,k) ; enddo ; enddo ; enddo endif - ! This call is just here to initialize uh and vh. - if (.not. query_initialized(uh, "uh", restart_CS) .or. & - .not. query_initialized(vh, "vh", restart_CS)) then - do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo - call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) - call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) - enddo ; enddo ; enddo - call set_initialized(uh, "uh", restart_CS) - call set_initialized(vh, "vh", restart_CS) - call set_initialized(CS%h_av, "h2", restart_CS) + if (CS%store_CAu) then + if (query_initialized(CS%CAu_pred, "CAu", restart_CS) .and. & + query_initialized(CS%CAv_pred, "CAv", restart_CS)) then + CS%CAu_pred_stored = .true. + else + call only_read_from_restarts(uh, vh, 'uh', 'vh', G, restart_CS, stagger=CGRID_NE, & + filename=dirs%input_filename, directory=dirs%restart_input_dir, & + success=read_uv, scale=US%m_to_L**2*US%T_to_s/GV%H_to_mks) + call only_read_from_restarts('h2', CS%h_av, G, restart_CS, & + filename=dirs%input_filename, directory=dirs%restart_input_dir, & + success=read_h2, scale=1.0/GV%H_to_mks) + if (read_uv .and. read_h2) then + call pass_var(CS%h_av, G%Domain, clock=id_clock_pass_init) + else + do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo + call continuity(CS%u_av, CS%v_av, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) + call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) + enddo ; enddo ; enddo + endif + call pass_vector(CS%u_av, CS%v_av, G%Domain, halo=2, clock=id_clock_pass_init, complete=.false.) + call pass_vector(uh, vh, G%Domain, halo=2, clock=id_clock_pass_init, complete=.true.) + call CorAdCalc(CS%u_av, CS%v_av, CS%h_av, uh, vh, CS%CAu_pred, CS%CAv_pred, CS%OBC, CS%ADp, & + G, GV, US, CS%CoriolisAdv, pbv) !, Waves=Waves) + CS%CAu_pred_stored = .true. + endif else - if (.not. query_initialized(CS%h_av, "h2", restart_CS)) then - CS%h_av(:,:,:) = h(:,:,:) + CS%CAu_pred_stored = .false. + ! This call is just here to initialize uh and vh. + if (.not. query_initialized(uh, "uh", restart_CS) .or. & + .not. query_initialized(vh, "vh", restart_CS)) then + do k=1,nz ; do j=jsd,jed ; do i=isd,ied ; h_tmp(i,j,k) = h(i,j,k) ; enddo ; enddo ; enddo + call continuity(u, v, h, h_tmp, uh, vh, dt, G, GV, US, CS%continuity_CSp, CS%OBC, pbv) + call pass_var(h_tmp, G%Domain, clock=id_clock_pass_init) + do k=1,nz ; do j=jsd,jed ; do i=isd,ied + CS%h_av(i,j,k) = 0.5*(h(i,j,k) + h_tmp(i,j,k)) + enddo ; enddo ; enddo + call set_initialized(uh, "uh", restart_CS) + call set_initialized(vh, "vh", restart_CS) call set_initialized(CS%h_av, "h2", restart_CS) - elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then - H_rescale = 1.0 / GV%m_to_H_restart - do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo - endif - if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= (GV%m_to_H_restart * US%m_to_L_restart**2)) ) then - uH_rescale = US%s_to_T_restart / (GV%m_to_H_restart * US%m_to_L_restart**2) - do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo - do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + ! Try reading the CAu and CAv fields from the restart file, in case this restart file is + ! using a newer format. + call only_read_from_restarts(CS%CAu_pred, CS%CAv_pred, "CAu", "CAv", G, restart_CS, & + stagger=CGRID_NE, filename=dirs%input_filename, directory=dirs%restart_input_dir, & + success=read_uv, scale=US%m_s_to_L_T*US%T_to_s) + CS%CAu_pred_stored = read_uv + else + if (.not. query_initialized(CS%h_av, "h2", restart_CS)) then + CS%h_av(:,:,:) = h(:,:,:) + call set_initialized(CS%h_av, "h2", restart_CS) + elseif ((GV%m_to_H_restart /= 0.0) .and. (GV%m_to_H_restart /= 1.0)) then + H_rescale = 1.0 / GV%m_to_H_restart + do k=1,nz ; do j=js,je ; do i=is,ie ; CS%h_av(i,j,k) = H_rescale * CS%h_av(i,j,k) ; enddo ; enddo ; enddo + endif + if ( (GV%m_to_H_restart * US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & + (US%s_to_T_restart /= (GV%m_to_H_restart * US%m_to_L_restart**2)) ) then + uH_rescale = US%s_to_T_restart / (GV%m_to_H_restart * US%m_to_L_restart**2) + do k=1,nz ; do j=js,je ; do I=G%IscB,G%IecB ; uh(I,j,k) = uH_rescale * uh(I,j,k) ; enddo ; enddo ; enddo + do k=1,nz ; do J=G%JscB,G%JecB ; do i=is,ie ; vh(i,J,k) = uH_rescale * vh(i,J,k) ; enddo ; enddo ; enddo + endif endif endif - call cpu_clock_begin(id_clock_pass_init) call create_group_pass(pass_av_h_uvh, CS%u_av, CS%v_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) - call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) + if (CS%CAu_pred_stored) then + call create_group_pass(pass_av_h_uvh, CS%CAu_pred, CS%CAv_pred, G%Domain, halo=2) + else + call create_group_pass(pass_av_h_uvh, CS%h_av, G%Domain, halo=2) + call create_group_pass(pass_av_h_uvh, uh, vh, G%Domain, halo=2) + endif call do_group_pass(pass_av_h_uvh, G%Domain) call cpu_clock_end(id_clock_pass_init) @@ -1596,11 +1703,12 @@ subroutine end_dyn_split_RK2(CS) deallocate(CS%vertvisc_CSp) call hor_visc_end(CS%hor_visc) - call tidal_forcing_end(CS%tides_CSp) + if (CS%use_tides) call tidal_forcing_end(CS%tides_CSp) call CoriolisAdv_end(CS%CoriolisAdv) DEALLOC_(CS%diffu) ; DEALLOC_(CS%diffv) DEALLOC_(CS%CAu) ; DEALLOC_(CS%CAv) + DEALLOC_(CS%CAu_pred) ; DEALLOC_(CS%CAv_pred) DEALLOC_(CS%PFu) ; DEALLOC_(CS%PFv) if (associated(CS%taux_bot)) deallocate(CS%taux_bot) @@ -1613,6 +1721,7 @@ subroutine end_dyn_split_RK2(CS) DEALLOC_(CS%h_av) ; DEALLOC_(CS%u_av) ; DEALLOC_(CS%v_av) call dealloc_BT_cont_type(CS%BT_cont) + deallocate(CS%AD_pred) deallocate(CS) end subroutine end_dyn_split_RK2 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index a7517ccc4f..bc20c30a0f 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -50,7 +50,7 @@ module MOM_dynamics_unsplit !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_type use MOM_variables, only : accel_diag_ptrs, ocean_internal_state, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -217,7 +217,7 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, forces, & !! initialize_dyn_unsplit. type(VarMix_CS), intent(inout) :: VarMix !< Variable mixing control structure type(MEKE_type), intent(inout) :: MEKE !< MEKE fields - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics type(wave_parameters_CS), optional, pointer :: Waves !< A pointer to a structure containing !! fields related to the surface wave conditions diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index 9acb2b5c83..957306eb3d 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -48,7 +48,7 @@ module MOM_dynamics_unsplit_RK2 !* * !********+*********+*********+*********+*********+*********+*********+** -use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_ptrs +use MOM_variables, only : vertvisc_type, thermo_var_ptrs, porous_barrier_type use MOM_variables, only : ocean_internal_state, accel_diag_ptrs, cont_diag_ptrs use MOM_forcing_type, only : mech_forcing use MOM_checksum_packages, only : MOM_thermo_chksum, MOM_state_chksum, MOM_accel_chksum @@ -230,7 +230,7 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, type(MEKE_type), intent(inout) :: MEKE !< MEKE fields !! fields related to the Mesoscale !! Eddy Kinetic Energy. - type(porous_barrier_ptrs), intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type), intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h_av ! Averaged layer thicknesses [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: hp ! Predicted layer thicknesses [H ~> m or kg m-2] diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index f73fcc33af..f3a48f3ded 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -90,6 +90,7 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. + OBCmaskCu, & !< 0 for boundary or OBC points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points in degrees of latitude or m. geoLonCu, & !< The geographic longitude at u points in degrees of longitude or m. dxCu, & !< dxCu is delta x at u points [L ~> m]. @@ -102,6 +103,7 @@ module MOM_grid real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. + OBCmaskCv, & !< 0 for boundary or OBC points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points in degrees of latitude or m. geoLonCv, & !< The geographic longitude at v points in degrees of longitude or m. dxCv, & !< dxCv is delta x at v points [L ~> m]. @@ -113,13 +115,13 @@ module MOM_grid areaCv !< The areas of the v-grid cells [L2 ~> m2]. real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_) :: & - porous_DminU, & !< minimum topographic height of U-face [Z ~> m] - porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DminU, & !< minimum topographic height (deepest) of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height (shallowest) of U-face [Z ~> m] porous_DavgU !< average topographic height of U-face [Z ~> m] real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: & - porous_DminV, & !< minimum topographic height of V-face [Z ~> m] - porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DminV, & !< minimum topographic height (deepest) of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height (shallowest) of V-face [Z ~> m] porous_DavgV !< average topographic height of V-face [Z ~> m] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & @@ -573,7 +575,9 @@ subroutine allocate_metrics(G) ALLOC_(G%mask2dT(isd:ied,jsd:jed)) ; G%mask2dT(:,:) = 0.0 ALLOC_(G%mask2dCu(IsdB:IedB,jsd:jed)) ; G%mask2dCu(:,:) = 0.0 + ALLOC_(G%OBCmaskCu(IsdB:IedB,jsd:jed)) ; G%OBCmaskCu(:,:) = 0.0 ALLOC_(G%mask2dCv(isd:ied,JsdB:JedB)) ; G%mask2dCv(:,:) = 0.0 + ALLOC_(G%OBCmaskCv(isd:ied,JsdB:JedB)) ; G%OBCmaskCv(:,:) = 0.0 ALLOC_(G%mask2dBu(IsdB:IedB,JsdB:JedB)) ; G%mask2dBu(:,:) = 0.0 ALLOC_(G%geoLatT(isd:ied,jsd:jed)) ; G%geoLatT(:,:) = 0.0 ALLOC_(G%geoLatCu(IsdB:IedB,jsd:jed)) ; G%geoLatCu(:,:) = 0.0 @@ -637,8 +641,8 @@ subroutine MOM_grid_end(G) DEALLOC_(G%areaCu) ; DEALLOC_(G%IareaCu) DEALLOC_(G%areaCv) ; DEALLOC_(G%IareaCv) - DEALLOC_(G%mask2dT) ; DEALLOC_(G%mask2dCu) - DEALLOC_(G%mask2dCv) ; DEALLOC_(G%mask2dBu) + DEALLOC_(G%mask2dT) ; DEALLOC_(G%mask2dCu) ; DEALLOC_(G%OBCmaskCu) + DEALLOC_(G%mask2dCv) ; DEALLOC_(G%OBCmaskCv) ; DEALLOC_(G%mask2dBu) DEALLOC_(G%geoLatT) ; DEALLOC_(G%geoLatCu) DEALLOC_(G%geoLatCv) ; DEALLOC_(G%geoLatBu) @@ -686,6 +690,7 @@ end subroutine MOM_grid_end !! !! Each location also has a 2D mask indicating whether the entire column is land or ocean. !! `mask2dT` is 1 if the column is wet or 0 if the T-cell is land. -!! `mask2dCu` is 1 if both neighboring column are ocean, and 0 if either is land. +!! `mask2dCu` is 1 if both neighboring columns are ocean, and 0 if either is land. +!! `OBCmasku` is 1 if both neighboring columns are ocean, and 0 if either is land of if this is OBC point. end module MOM_grid diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index edaa2bc1d8..1cc8505d17 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -116,7 +116,8 @@ module MOM_open_boundary !! Not sure who should lock it or when... end type segment_tracer_registry_type -!> Open boundary segment data structure. +!> Open boundary segment data structure. Unless otherwise noted, 2-d and 3-d arrays are discretized +!! at the same position as normal velocity points in the middle of the OBC segments. type, public :: OBC_segment_type logical :: Flather !< If true, applies Flather + Chapman radiation of barotropic gravity waves. logical :: radiation !< If true, 1D Orlanksi radiation boundary conditions are applied. @@ -136,7 +137,8 @@ module MOM_open_boundary logical :: specified !< Boundary normal velocity fixed to external value. logical :: specified_tan !< Boundary tangential velocity fixed to external value. logical :: specified_grad !< Boundary gradient of tangential velocity fixed to external value. - logical :: open !< Boundary is open for continuity solver. + logical :: open !< Boundary is open for continuity solver, and there are no other + !! parameterized mass fluxes at the open boundary. logical :: gradient !< Zero gradient at boundary. logical :: values_needed !< Whether or not any external OBC fields are needed. logical :: u_values_needed !< Whether or not external u OBC fields are needed. @@ -178,10 +180,10 @@ module MOM_open_boundary real, allocatable :: h(:,:,:) !< The cell thickness [H ~> m or kg m-2] at OBC-points. real, allocatable :: normal_vel(:,:,:) !< The layer velocity normal to the OB !! segment [L T-1 ~> m s-1]. - real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the - !! OB segment [L T-1 ~> m s-1]. - real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential - !! to the OB segment [T-1 ~> s-1]. + real, allocatable :: tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment + !! [L T-1 ~> m s-1], discretized at the corner points. + real, allocatable :: tangential_grad(:,:,:) !< The gradient of the velocity tangential to the OB + !! segment [T-1 ~> s-1], discretized at the corner points. real, allocatable :: normal_trans(:,:,:) !< The layer transport normal to the OB !! segment [H L2 T-1 ~> m3 s-1]. real, allocatable :: normal_vel_bt(:,:) !< The barotropic velocity normal to @@ -189,25 +191,38 @@ module MOM_open_boundary real, allocatable :: eta(:,:) !< The sea-surface elevation along the !! segment [H ~> m or kg m-2]. real, allocatable :: grad_normal(:,:,:) !< The gradient of the normal flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] + !! segment times the grid spacing [L T-1 ~> m s-1], + !! with the first index being the corner-point index + !! along the segment, and the second index being 1 (for + !! values one point into the domain) or 2 (for values + !! along the OBC itself) real, allocatable :: grad_tan(:,:,:) !< The gradient of the tangential flow along the - !! segment times the grid spacing [L T-1 ~> m s-1] - real, allocatable :: grad_gradient(:,:,:) !< The gradient of the gradient of tangential flow along - !! the segment times the grid spacing [T-1 ~> s-1] + !! segment times the grid spacing [L T-1 ~> m s-1], with the + !! first index being the velocity/tracer point index along the + !! segment, and the second being 1 for the value 1.5 points + !! inside the domain and 2 for the value half a point + !! inside the domain. + real, allocatable :: grad_gradient(:,:,:) !< The gradient normal to the segment of the gradient + !! tangetial to the segment of tangential flow along the segment + !! times the grid spacing [T-1 ~> s-1], with the first + !! index being the velocity/tracer point index along the segment, + !! and the second being 1 for the value 2 points into the domain + !! and 2 for the value 1 point into the domain. real, allocatable :: rx_norm_rad(:,:,:) !< The previous normal phase speed use for EW radiation !! OBC, in grid points per timestep [nondim] real, allocatable :: ry_norm_rad(:,:,:) !< The previous normal phase speed use for NS radiation !! OBC, in grid points per timestep [nondim] - real, allocatable :: rx_norm_obl(:,:,:) !< The previous normal radiation coefficient for EW - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, allocatable :: ry_norm_obl(:,:,:) !< The previous normal radiation coefficient for NS - !! oblique OBCs [L2 T-2 ~> m2 s-2] - real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation - !! for normal velocity [L2 T-2 ~> m2 s-2] + real, allocatable :: rx_norm_obl(:,:,:) !< The previous x-direction normalized radiation coefficient + !! for either EW or NS oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_norm_obl(:,:,:) !< The previous y-direction normalized radiation coefficient + !! for either EW or NS oblique OBCs [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal(:,:,:) !< The denominator for oblique radiation of the normal + !! velocity [L2 T-2 ~> m2 s-2] real, allocatable :: nudged_normal_vel(:,:,:) !< The layer velocity normal to the OB segment !! that values should be nudged towards [L T-1 ~> m s-1]. real, allocatable :: nudged_tangential_vel(:,:,:) !< The layer velocity tangential to the OB segment - !! that values should be nudged towards [L T-1 ~> m s-1]. + !! that values should be nudged towards [L T-1 ~> m s-1], + !! discretized at the corner (PV) points. real, allocatable :: nudged_tangential_grad(:,:,:) !< The layer dvdx or dudy towards which nudging !! can occur [T-1 ~> s-1]. type(segment_tracer_registry_type), pointer :: tr_Reg=> NULL()!< A pointer to the tracer registry for the segment. @@ -304,9 +319,18 @@ module MOM_open_boundary !! grid points per timestep [nondim] real, allocatable :: ry_normal(:,:,:) !< Array storage for normal phase speed for NS radiation OBCs in units of !! grid points per timestep [nondim] - real, allocatable :: rx_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, allocatable :: ry_oblique(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] - real, allocatable :: cff_normal(:,:,:) !< Array storage for oblique boundary condition restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: rx_oblique_u(:,:,:) !< X-direction oblique boundary condition radiation speeds squared + !! at u points for restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique_u(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared + !! at u points for restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: rx_oblique_v(:,:,:) !< X-direction oblique boundary condition radiation speeds squared + !! at v points for restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: ry_oblique_v(:,:,:) !< Y-direction oblique boundary condition radiation speeds squared + !! at v points for restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal_u(:,:,:) !< Denominator for normalizing EW oblique boundary condition radiation + !! rates at u points for restarts [L2 T-2 ~> m2 s-2] + real, allocatable :: cff_normal_v(:,:,:) !< Denominator for normalizing NS oblique boundary condition radiation + !! rates at v points for restarts [L2 T-2 ~> m2 s-2] real, allocatable :: tres_x(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] real, allocatable :: tres_y(:,:,:,:) !< Array storage of tracer reservoirs for restarts, in unscaled units [conc] logical :: debug !< If true, write verbose checksums for debugging purposes. @@ -1794,9 +1818,11 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) id_clock_pass = cpu_clock_id('(Ocean OBC halo updates)', grain=CLOCK_ROUTINE) if (OBC%radiation_BCs_exist_globally) call pass_vector(OBC%rx_normal, OBC%ry_normal, G%Domain, & To_All+Scalar_Pair) - if (OBC%oblique_BCs_exist_globally) call pass_vector(OBC%rx_oblique, OBC%ry_oblique, G%Domain, & - To_All+Scalar_Pair) - if (allocated(OBC%cff_normal)) call pass_var(OBC%cff_normal, G%Domain, position=CORNER) + if (OBC%oblique_BCs_exist_globally) then + call pass_vector(OBC%rx_oblique_u, OBC%ry_oblique_v, G%Domain, To_All+Scalar_Pair) + call pass_vector(OBC%ry_oblique_u, OBC%rx_oblique_v, G%Domain, To_All+Scalar_Pair) + call pass_vector(OBC%cff_normal_u, OBC%cff_normal_v, G%Domain, To_All+Scalar_Pair) + endif if (allocated(OBC%tres_x) .and. allocated(OBC%tres_y)) then do m=1,OBC%ntr call pass_vector(OBC%tres_x(:,:,:,m), OBC%tres_y(:,:,:,m), G%Domain, To_All+Scalar_Pair) @@ -1811,45 +1837,6 @@ subroutine open_boundary_init(G, GV, US, param_file, OBC, restart_CS) enddo endif - ! The rx_normal and ry_normal arrays used with radiation OBCs are currently in units of grid - ! points per timestep, but if this were to be corrected to [L T-1 ~> m s-1] or [T-1 ~> s-1] to - ! permit timesteps to change between calls to the OBC code, the following would be needed: -! if ( OBC%radiation_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & -! (US%s_to_T_restart /= US%m_to_L_restart) ) then -! vel_rescale = US%s_to_T_restart / US%m_to_L_restart -! if (query_initialized(OBC%rx_normal, "rx_normal", restart_CS)) then -! do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB -! OBC%rx_normal(I,j,k) = vel_rescale * OBC%rx_normal(I,j,k) -! enddo ; enddo ; enddo -! endif -! if (query_initialized(OBC%ry_normal, "ry_normal", restart_CS)) then -! do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied -! OBC%ry_normal(i,J,k) = vel_rescale * OBC%ry_normal(i,J,k) -! enddo ; enddo ; enddo -! endif -! endif - - ! The oblique boundary condition terms have units of [L2 T-2 ~> m2 s-2] and may need to be rescaled. - if ( OBC%oblique_BCs_exist_globally .and. (US%s_to_T_restart * US%m_to_L_restart /= 0.0) .and. & - (US%s_to_T_restart /= US%m_to_L_restart) ) then - vel2_rescale = US%s_to_T_restart**2 / US%m_to_L_restart**2 - if (query_initialized(OBC%rx_oblique, "rx_oblique", restart_CS)) then - do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB - OBC%rx_oblique(I,j,k) = vel2_rescale * OBC%rx_oblique(I,j,k) - enddo ; enddo ; enddo - endif - if (query_initialized(OBC%ry_oblique, "ry_oblique", restart_CS)) then - do k=1,nz ; do J=JsdB,JedB ; do i=isd,ied - OBC%ry_oblique(i,J,k) = vel2_rescale * OBC%ry_oblique(i,J,k) - enddo ; enddo ; enddo - endif - if (query_initialized(OBC%cff_normal, "cff_normal", restart_CS)) then - do k=1,nz ; do J=JsdB,JedB ; do I=IsdB,IedB - OBC%cff_normal(I,J,k) = vel2_rescale * OBC%cff_normal(I,J,k) - enddo ; enddo ; enddo - endif - endif - end subroutine open_boundary_init logical function open_boundary_query(OBC, apply_open_OBC, apply_specified_OBC, apply_Flather_OBC, & @@ -1891,9 +1878,12 @@ subroutine open_boundary_dealloc(OBC) if (allocated(OBC%segnum_v)) deallocate(OBC%segnum_v) if (allocated(OBC%rx_normal)) deallocate(OBC%rx_normal) if (allocated(OBC%ry_normal)) deallocate(OBC%ry_normal) - if (allocated(OBC%rx_oblique)) deallocate(OBC%rx_oblique) - if (allocated(OBC%ry_oblique)) deallocate(OBC%ry_oblique) - if (allocated(OBC%cff_normal)) deallocate(OBC%cff_normal) + if (allocated(OBC%rx_oblique_u)) deallocate(OBC%rx_oblique_u) + if (allocated(OBC%ry_oblique_u)) deallocate(OBC%ry_oblique_u) + if (allocated(OBC%rx_oblique_v)) deallocate(OBC%rx_oblique_v) + if (allocated(OBC%ry_oblique_v)) deallocate(OBC%ry_oblique_v) + if (allocated(OBC%cff_normal_u)) deallocate(OBC%cff_normal_u) + if (allocated(OBC%cff_normal_v)) deallocate(OBC%cff_normal_v) if (allocated(OBC%tres_x)) deallocate(OBC%tres_x) if (allocated(OBC%tres_y)) deallocate(OBC%tres_y) deallocate(OBC) @@ -1974,16 +1964,16 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) do j=segment%HI%jsd,segment%HI%jed if (G%mask2dCu(I,j) == 0) OBC%segnum_u(I,j) = OBC_NONE if (segment%direction == OBC_DIRECTION_W) then - G%mask2dT(i,j) = 0 + G%mask2dT(i,j) = 0.0 else - G%mask2dT(i+1,j) = 0 + G%mask2dT(i+1,j) = 0.0 endif enddo do J=segment%HI%JsdB+1,segment%HI%JedB-1 if (segment%direction == OBC_DIRECTION_W) then - G%mask2dCv(i,J) = 0 + G%mask2dCv(i,J) = 0 ; G%OBCmaskCv(i,J) = 0.0 else - G%mask2dCv(i+1,J) = 0 + G%mask2dCv(i+1,J) = 0.0 ; G%OBCmaskCv(i+1,J) = 0.0 endif enddo else @@ -1992,21 +1982,38 @@ subroutine open_boundary_impose_land_mask(OBC, G, areaCu, areaCv, US) do i=segment%HI%isd,segment%HI%ied if (G%mask2dCv(i,J) == 0) OBC%segnum_v(i,J) = OBC_NONE if (segment%direction == OBC_DIRECTION_S) then - G%mask2dT(i,j) = 0 + G%mask2dT(i,j) = 0.0 else - G%mask2dT(i,j+1) = 0 + G%mask2dT(i,j+1) = 0.0 endif enddo do I=segment%HI%IsdB+1,segment%HI%IedB-1 if (segment%direction == OBC_DIRECTION_S) then - G%mask2dCu(I,j) = 0 + G%mask2dCu(I,j) = 0.0 ; G%OBCmaskCu(I,j) = 0.0 else - G%mask2dCu(I,j+1) = 0 + G%mask2dCu(I,j+1) = 0.0 ; G%OBCmaskCu(I,j+1) = 0.0 endif enddo endif enddo + do n=1,OBC%number_of_segments + segment=>OBC%segment(n) + if (.not. (segment%on_pe .and. segment%open)) cycle + ! Set the OBCmask values to help eliminate certain terms at u- or v- OBC points. + if (segment%is_E_or_W) then + I=segment%HI%IsdB + do j=segment%HI%jsd,segment%HI%jed + G%OBCmaskCu(I,j) = 0.0 + enddo + else + J=segment%HI%JsdB + do i=segment%HI%isd,segment%HI%ied + G%OBCmaskCv(i,J) = 0.0 + enddo + endif + enddo + do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. segment%on_pe .or. .not. segment%specified) cycle @@ -2129,12 +2136,17 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, real :: cff_new, cff_avg ! denominator in oblique [L2 T-2 ~> m2 s-2] real, allocatable, dimension(:,:,:) :: & rx_tang_rad, & ! The phase speed at u-points for tangential oblique OBCs - ! in units of grid points per timestep [nondim] + ! in units of grid points per timestep [nondim], + ! discretized at the corner (PV) points. ry_tang_rad, & ! The phase speed at v-points for tangential oblique OBCs - ! in units of grid points per timestep [nondim] - rx_tang_obl, & ! The x-coefficient for tangential oblique OBCs [L2 T-2 ~> m2 s-2] - ry_tang_obl, & ! The y-coefficient for tangential oblique OBCs [L2 T-2 ~> m2 s-2] - cff_tangential ! The denominator for tangential oblique OBCs [L2 T-2 ~> m2 s-2] + ! in units of grid points per timestep [nondim], + ! discretized at the corner (PV) points. + rx_tang_obl, & ! The x-coefficient for tangential oblique OBCs [L2 T-2 ~> m2 s-2], + ! discretized at the corner (PV) points. + ry_tang_obl, & ! The y-coefficient for tangential oblique OBCs [L2 T-2 ~> m2 s-2], + ! discretized at the corner (PV) points. + cff_tangential ! The denominator for tangential oblique OBCs [L2 T-2 ~> m2 s-2], + ! discretized at the corner (PV) points. real :: eps ! A small velocity squared [L2 T-2 ~> m2 s-2] type(OBC_segment_type), pointer :: segment => NULL() integer :: i, j, k, is, ie, js, je, m, nz, n @@ -2175,18 +2187,18 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, do k=1,GV%ke I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed - segment%rx_norm_obl(I,j,k) = OBC%rx_oblique(I,j,k) - segment%ry_norm_obl(I,j,k) = OBC%ry_oblique(I,j,k) - segment%cff_normal(I,j,k) = OBC%cff_normal(I,j,k) + segment%rx_norm_obl(I,j,k) = OBC%rx_oblique_u(I,j,k) + segment%ry_norm_obl(I,j,k) = OBC%ry_oblique_u(I,j,k) + segment%cff_normal(I,j,k) = OBC%cff_normal_u(I,j,k) enddo enddo elseif (segment%is_N_or_S .and. segment%oblique) then do k=1,GV%ke J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied - segment%rx_norm_obl(i,J,k) = OBC%rx_oblique(i,J,k) - segment%ry_norm_obl(i,J,k) = OBC%ry_oblique(i,J,k) - segment%cff_normal(i,J,k) = OBC%cff_normal(i,J,k) + segment%rx_norm_obl(i,J,k) = OBC%rx_oblique_v(i,J,k) + segment%ry_norm_obl(i,J,k) = OBC%ry_oblique_v(i,J,k) + segment%cff_normal(i,J,k) = OBC%cff_normal_v(i,J,k) enddo enddo endif @@ -2269,16 +2281,16 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new - cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(I,j,k) + gamma_u*ry_new + cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new else rx_avg = rx_new ry_avg = ry_new cff_avg = cff_new endif segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg + segment%ry_norm_obl(I,j,k) = ry_avg + segment%cff_normal(I,j,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I-1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & @@ -2286,9 +2298,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (gamma_u < 1.0) then ! Copy restart fields into 3-d arrays. This is an inefficient and temporary ! implementation as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) + OBC%rx_oblique_u(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique_u(I,j,k) = segment%ry_norm_obl(I,j,k) + OBC%cff_normal_u(I,j,k) = segment%cff_normal(I,j,k) endif elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I-1,j,k) @@ -2409,9 +2421,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new + rx_tang_obl(I,J,k) = rx_new + ry_tang_obl(I,J,k) = ry_new + cff_tangential(I,J,k) = cff_new enddo endif enddo @@ -2514,7 +2526,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) if (gamma_u < 1.0) then rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new - ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new + ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(I,j,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(I,j,k) + gamma_u*cff_new else rx_avg = rx_new @@ -2522,8 +2534,8 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, cff_avg = cff_new endif segment%rx_norm_obl(I,j,k) = rx_avg - segment%ry_norm_obl(i,J,k) = ry_avg - segment%cff_normal(i,J,k) = cff_avg + segment%ry_norm_obl(I,j,k) = ry_avg + segment%cff_normal(I,j,k) = cff_avg segment%normal_vel(I,j,k) = ((cff_avg*u_new(I,j,k) + rx_avg*u_new(I+1,j,k)) - & (max(ry_avg,0.0)*segment%grad_normal(J-1,2,k) + & min(ry_avg,0.0)*segment%grad_normal(J,2,k))) / & @@ -2531,9 +2543,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (gamma_u < 1.0) then ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(I,j,k) = segment%cff_normal(I,j,k) + OBC%rx_oblique_u(I,j,k) = segment%rx_norm_obl(I,j,k) + OBC%ry_oblique_u(I,j,k) = segment%ry_norm_obl(I,j,k) + OBC%cff_normal_u(I,j,k) = segment%cff_normal(I,j,k) endif elseif (segment%gradient) then segment%normal_vel(I,j,k) = u_new(I+1,j,k) @@ -2654,9 +2666,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) rx_new = min(dhdt*dhdx, cff_new*rx_max) ry_new = min(cff_new,max(dhdt*dhdy,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new + rx_tang_obl(I,J,k) = rx_new + ry_tang_obl(I,J,k) = ry_new + cff_tangential(I,J,k) = cff_new enddo endif enddo @@ -2765,7 +2777,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, ry_avg = ry_new cff_avg = cff_new endif - segment%rx_norm_obl(I,j,k) = rx_avg + segment%rx_norm_obl(i,J,k) = rx_avg segment%ry_norm_obl(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J-1,k)) - & @@ -2775,9 +2787,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (gamma_u < 1.0) then ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) + OBC%rx_oblique_v(i,J,k) = segment%rx_norm_obl(i,J,k) + OBC%ry_oblique_v(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal_v(i,J,k) = segment%cff_normal(i,J,k) endif elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J-1,k) @@ -2898,9 +2910,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new + rx_tang_obl(I,J,k) = rx_new + ry_tang_obl(I,J,k) = ry_new + cff_tangential(I,J,k) = cff_new enddo endif enddo @@ -3002,7 +3014,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) if (gamma_u < 1.0) then - rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(I,j,k) + gamma_u*rx_new + rx_avg = (1.0-gamma_u)*segment%rx_norm_obl(i,J,k) + gamma_u*rx_new ry_avg = (1.0-gamma_u)*segment%ry_norm_obl(i,J,k) + gamma_u*ry_new cff_avg = (1.0-gamma_u)*segment%cff_normal(i,J,k) + gamma_u*cff_new else @@ -3010,7 +3022,7 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, ry_avg = ry_new cff_avg = cff_new endif - segment%rx_norm_obl(I,j,k) = rx_avg + segment%rx_norm_obl(i,J,k) = rx_avg segment%ry_norm_obl(i,J,k) = ry_avg segment%cff_normal(i,J,k) = cff_avg segment%normal_vel(i,J,k) = ((cff_avg*v_new(i,J,k) + ry_avg*v_new(i,J+1,k)) - & @@ -3020,9 +3032,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, if (gamma_u < 1.0) then ! Copy restart fields into 3-d arrays. This is an inefficient and temporary issues ! implemented as a work-around to limitations in restart capability - OBC%rx_oblique(I,j,k) = segment%rx_norm_obl(I,j,k) - OBC%ry_oblique(i,J,k) = segment%ry_norm_obl(i,J,k) - OBC%cff_normal(i,J,k) = segment%cff_normal(i,J,k) + OBC%rx_oblique_v(i,J,k) = segment%rx_norm_obl(i,J,k) + OBC%ry_oblique_v(i,J,k) = segment%ry_norm_obl(i,J,k) + OBC%cff_normal_v(i,J,k) = segment%cff_normal(i,J,k) endif elseif (segment%gradient) then segment%normal_vel(i,J,k) = v_new(i,J+1,k) @@ -3143,9 +3155,9 @@ subroutine radiation_open_bdry_conds(OBC, u_new, u_old, v_new, v_old, G, GV, US, cff_new = max(dhdx*dhdx + dhdy*dhdy, eps) ry_new = min(dhdt*dhdy, cff_new*ry_max) rx_new = min(cff_new,max(dhdt*dhdx,-cff_new)) - rx_tang_obl(I,j,k) = rx_new - ry_tang_obl(i,J,k) = ry_new - cff_tangential(i,J,k) = cff_new + rx_tang_obl(I,J,k) = rx_new + ry_tang_obl(I,J,k) = ry_new + cff_tangential(I,J,k) = cff_new enddo endif enddo @@ -4991,18 +5003,28 @@ subroutine open_boundary_register_restarts(HI, GV, US, OBC, Reg, param_file, res endif if (OBC%oblique_BCs_exist_globally) then - allocate(OBC%rx_oblique(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) - allocate(OBC%ry_oblique(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) - - vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') - vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') - call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), .false., & + allocate(OBC%rx_oblique_u(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%ry_oblique_u(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%cff_normal_u(HI%IsdB:HI%IedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%rx_oblique_v(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) + allocate(OBC%ry_oblique_v(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) + allocate(OBC%cff_normal_v(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) + + vd(1) = var_desc("rx_oblique_u", "m2 s-2", "X-Direction Radiation Speed Squared for EW oblique OBCs", 'u', 'L') + vd(2) = var_desc("ry_oblique_v", "m2 s-2", "Y-Direction Radiation Speed Squared for NS oblique OBCs", 'v', 'L') + call register_restart_pair(OBC%rx_oblique_u, OBC%ry_oblique_v, vd(1), vd(2), .false., & + restart_CS, conversion=US%L_T_to_m_s**2) + vd(1) = var_desc("ry_oblique_u", "m2 s-2", "Y-Direction Radiation Speed Squared for EW oblique OBCs", 'u', 'L') + vd(2) = var_desc("rx_oblique_v", "m2 s-2", "X-Direction Radiation Speed Squared for NS oblique OBCs", 'v', 'L') + call register_restart_pair(OBC%ry_oblique_u, OBC%rx_oblique_v, vd(1), vd(2), .false., & restart_CS, conversion=US%L_T_to_m_s**2) - allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) - call register_restart_field(OBC%cff_normal, "cff_normal", .false., restart_CS, & - longname="denominator for oblique OBCs", & - units="m2 s-2", conversion=US%L_T_to_m_s**2, hor_grid="q") + vd(1) = var_desc("norm_oblique_u", "m2 s-2", "Denominator for normalizing EW oblique OBC radiation rates", & + 'u', 'L') + vd(2) = var_desc("norm_oblique_v", "m2 s-2", "Denominator for normalizing NS oblique OBC radiation rates", & + 'v', 'L') + call register_restart_pair(OBC%cff_normal_u, OBC%cff_normal_v, vd(1), vd(2), .false., & + restart_CS, conversion=US%L_T_to_m_s**2) endif if (Reg%ntr == 0) return @@ -5070,6 +5092,7 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) real, intent(in) :: dt !< time increment [T ~> s] type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry + ! Local variable type(OBC_segment_type), pointer :: segment=>NULL() real :: u_L_in, u_L_out ! The zonal distance moved in or out of a cell, normalized by the reservoir ! length scale [nondim] @@ -5080,6 +5103,12 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) ! For salinity the units would be [ppt S-1 ~> 1] integer :: i, j, k, m, n, ntr, nz integer :: ishift, idir, jshift, jdir + real :: b_in, b_out ! The 0 and 1 switch for tracer reservoirs + ! 1 if the length scale of reservoir is zero [nodim] + real :: a_in, a_out ! The 0 and 1(-1) switch for reservoir source weights + ! e.g. a_in is -1 only if b_in ==1 and uhr or vhr is inward + ! e.g. a_out is 1 only if b_out==1 and uhr or vhr is outward + ! It's clear that a_in and a_out cannot be both non-zero [nodim] nz = GV%ke ntr = Reg%ntr @@ -5087,6 +5116,8 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) if (associated(OBC)) then ; if (OBC%OBC_pe) then ; do n=1,OBC%number_of_segments segment=>OBC%segment(n) if (.not. associated(segment%tr_Reg)) cycle + b_in = 0.0; if (segment%Tr_InvLscale_in == 0.0) b_in = 1.0 + b_out = 0.0; if (segment%Tr_InvLscale_out == 0.0) b_out = 1.0 if (segment%is_E_or_W) then I = segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed @@ -5103,14 +5134,21 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) do m=1,ntr I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + ! Calculate weights. Both a and u_L are nodim. Adding them together has no meaning. + ! However, since they cannot be both non-zero, adding them works like a switch. + ! When InvLscale_out is 0 and outflow, only interior data is applied to reservoirs + ! When InvLscale_in is 0 and inflow, only nudged data is applied to reservoirs + a_out = b_out * max(0.0, sign(1.0, idir*uhr(I,j,k))) + a_in = b_in * min(0.0, sign(1.0, idir*uhr(I,j,k))) u_L_out = max(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_out / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) u_L_in = min(0.0, (idir*uhr(I,j,k))*segment%Tr_InvLscale_in / & ((h(i+ishift,j,k) + GV%H_subroundoff)*G%dyCu(I,j))) - fac1 = 1.0 + (u_L_out-u_L_in) - segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(I,j,k) + & - (u_L_out*Reg%Tr(m)%t(I+ishift,j,k) - & - u_L_in*segment%tr_Reg%Tr(m)%t(I,j,k))) + fac1 = (1.0 - (a_out - a_in)) + ((u_L_out + a_out) - (u_L_in + a_in)) + segment%tr_Reg%Tr(m)%tres(I,j,k) = (1.0/fac1) * & + ((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(I,j,k)+ & + ((u_L_out+a_out)*Reg%Tr(m)%t(I+ishift,j,k) - & + (u_L_in+a_in)*segment%tr_Reg%Tr(m)%t(I,j,k))) if (allocated(OBC%tres_x)) OBC%tres_x(I,j,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(I,j,k) enddo ; endif enddo @@ -5131,14 +5169,18 @@ subroutine update_segment_tracer_reservoirs(G, GV, uhr, vhr, h, OBC, dt, Reg) do m=1,ntr I_scale = 1.0 ; if (segment%tr_Reg%Tr(m)%scale /= 0.0) I_scale = 1.0 / segment%tr_Reg%Tr(m)%scale if (allocated(segment%tr_Reg%Tr(m)%tres)) then ; do k=1,nz + a_out = b_out * max(0.0, sign(1.0, jdir*vhr(i,J,k))) + a_in = b_in * min(0.0, sign(1.0, jdir*vhr(i,J,k))) v_L_out = max(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_out / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) v_L_in = min(0.0, (jdir*vhr(i,J,k))*segment%Tr_InvLscale_in / & ((h(i,j+jshift,k) + GV%H_subroundoff)*G%dxCv(i,J))) fac1 = 1.0 + (v_L_out-v_L_in) - segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1)*(segment%tr_Reg%Tr(m)%tres(i,J,k) + & - (v_L_out*Reg%Tr(m)%t(i,J+jshift,k) - & - v_L_in*segment%tr_Reg%Tr(m)%t(i,J,k))) + fac1 = (1.0 - (a_out - a_in)) + ((v_L_out + a_out) - (v_L_in + a_in)) + segment%tr_Reg%Tr(m)%tres(i,J,k) = (1.0/fac1) * & + ((1.0-a_out+a_in)*segment%tr_Reg%Tr(m)%tres(i,J,k) + & + ((v_L_out+a_out)*Reg%Tr(m)%t(i,J+jshift,k) - & + (v_L_in+a_in)*segment%tr_Reg%Tr(m)%t(i,J,k))) if (allocated(OBC%tres_y)) OBC%tres_y(i,J,k,m) = I_scale * segment%tr_Reg%Tr(m)%tres(i,J,k) enddo ; endif enddo diff --git a/src/core/MOM_porous_barriers.F90 b/src/core/MOM_porous_barriers.F90 index e807f19484..0e48cf07fd 100644 --- a/src/core/MOM_porous_barriers.F90 +++ b/src/core/MOM_porous_barriers.F90 @@ -4,165 +4,486 @@ module MOM_porous_barriers ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_error_handler, only : MOM_error, FATAL -use MOM_grid, only : ocean_grid_type -use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, porous_barrier_ptrs -use MOM_verticalGrid, only : verticalGrid_type +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_MODULE +use MOM_error_handler, only : MOM_error, FATAL +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, porous_barrier_type +use MOM_verticalGrid, only : verticalGrid_type use MOM_interface_heights, only : find_eta +use MOM_time_manager, only : time_type +use MOM_diag_mediator, only : register_diag_field, diag_ctrl, post_data +use MOM_file_parser, only : param_file_type, get_param, log_version +use MOM_unit_scaling, only : unit_scale_type +use MOM_debugging, only : hchksum, uvchksum implicit none ; private +public porous_widths_layer, porous_widths_interface, porous_barriers_init + #include -public porous_widths +!> The control structure for the MOM_porous_barriers module +type, public :: porous_barrier_CS; private + logical :: initialized = .false. !< True if this control structure has been initialized. + type(diag_ctrl), pointer :: & + diag => Null() !< A structure to regulate diagnostic output timing + logical :: debug !< If true, write verbose checksums for debugging purposes. + real :: mask_depth !< The depth shallower than which porous barrier is not applied. + integer :: eta_interp !< An integer indicating how the interface heights at the velocity + !! points are calculated. Valid values are given by the parameters + !! defined below: MAX, MIN, ARITHMETIC and HARMONIC. + integer :: answer_date !< The vintage of the porous barrier weight function calculations. + !! Values below 20220806 recover the old answers in which the layer + !! averaged weights are not strictly limited by an upper-bound of 1.0 . + !>@{ Diagnostic IDs + integer :: id_por_layer_widthU = -1, id_por_layer_widthV = -1, & + id_por_face_areaU = -1, id_por_face_areaV = -1 + !>@} +end type porous_barrier_CS + +integer :: id_clock_porous_barrier !< CPU clock for porous barrier -!> Calculates curve fit from D_min, D_max, D_avg -interface porous_widths - module procedure por_widths, calc_por_layer -end interface porous_widths +!>@{ Enumeration values for eta interpolation schemes +integer, parameter :: ETA_INTERP_MAX = 1 +integer, parameter :: ETA_INTERP_MIN = 2 +integer, parameter :: ETA_INTERP_ARITH = 3 +integer, parameter :: ETA_INTERP_HARM = 4 +character(len=20), parameter :: ETA_INTERP_MAX_STRING = "MAX" +character(len=20), parameter :: ETA_INTERP_MIN_STRING = "MIN" +character(len=20), parameter :: ETA_INTERP_ARITH_STRING = "ARITHMETIC" +character(len=20), parameter :: ETA_INTERP_HARM_STRING = "HARMONIC" +!>@} contains -!> subroutine to assign cell face areas and layer widths for porous topography -subroutine por_widths(h, tv, G, GV, US, eta, pbv, eta_bt, halo_size, eta_to_m) - !eta_bt, halo_size, eta_to_m not currently used - !variables needed to call find_eta - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various - !! thermodynamic variables. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights - !! [Z ~> m] or 1/eta_to_m m). - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic - !! variable that gives the "correct" free surface height (Boussinesq) or total water - !! column mass per unit area (non-Boussinesq). This is used to dilate the layer. - !! thicknesses when calculating interfaceheights [H ~> m or kg m-2]. - integer, optional, intent(in) :: halo_size !< width of halo points on - !! which to calculate eta. - - real, optional, intent(in) :: eta_to_m !< The conversion factor from - !! the units of eta to m; by default this is US%Z_to_m. - type(porous_barrier_ptrs), intent(inout) :: pbv !< porous barrier fractional cell metrics +!> subroutine to assign porous barrier widths averaged over a layer +subroutine porous_widths_layer(h, tv, G, GV, US, pbv, CS, eta_bt) + ! Note: eta_bt is not currently used + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable + !! used to dilate the layer thicknesses + !! [H ~> m or kg m-2]. + type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier !local variables - integer i, j, k, nk, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real w_layer, & ! fractional open width of layer interface [nondim] - A_layer, & ! integral of fractional open width from bottom to current layer[Z ~> m] - A_layer_prev, & ! integral of fractional open width from bottom to previous layer [Z ~> m] - eta_s, & ! layer height used for fit [Z ~> m] - eta_prev ! interface height of previous layer [Z ~> m] - isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed - IsdB = G%IsdB; IedB = G%IedB; JsdB = G%JsdB; JedB = G%JedB - - !eta is zero at surface and decreases downward - - nk = SZK_(G) - - !currently no treatment for using optional find_eta arguments if present - call find_eta(h, tv, G, GV, US, eta) - - do j=jsd,jed; do I=IsdB,IedB - if (G%porous_DavgU(I,j) < 0.) then - do K = nk+1,1,-1 - eta_s = max(eta(I,j,K), eta(I+1,j,K)) !take shallower layer height - if (eta_s <= G%porous_DminU(I,j)) then - pbv%por_layer_widthU(I,j,K) = 0.0 - A_layer_prev = 0.0 - if (K < nk+1) then - pbv%por_face_areaU(I,j,k) = 0.0; endif - else - call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), & - G%porous_DavgU(I,j), eta_s, w_layer, A_layer) - pbv%por_layer_widthU(I,j,K) = w_layer - if (k <= nk) then - if ((eta_s - eta_prev) > 0.0) then - pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev)/& - (eta_s-eta_prev) - else - pbv%por_face_areaU(I,j,k) = 0.0; endif - endif - eta_prev = eta_s - A_layer_prev = A_layer - endif + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: eta_u ! Layer interface heights at u points [Z ~> m] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: eta_v ! Layer interface heights at v points [Z ~> m] + real, dimension(SZIB_(G),SZJB_(G)) :: A_layer_prev ! Integral of fractional open width from the bottom + ! to the previous layer at u or v points [Z ~> m] + logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points + ! updated while moving up layers + real :: A_layer ! Integral of fractional open width from bottom to current layer [Z ~> m] + real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. + real :: h_neglect, & ! Negligible thicknesses, often [Z ~> m] + h_min ! ! The minimum layer thickness, often [Z ~> m] + real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] + integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_Porous_barrier: Module must be initialized before it is used.") + + call cpu_clock_begin(id_clock_porous_barrier) + + is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke + Isq = G%IscB; Ieq = G%IecB; Jsq = G%JscB; Jeq = G%JecB + + if (CS%answer_date < 20220806) then + dmask = 0.0 + else + dmask = CS%mask_depth + endif + + call calc_eta_at_uv(eta_u, eta_v, CS%eta_interp, dmask, h, tv, G, GV, US) + + Z_to_eta = 1.0 + H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta + h_min = GV%Angstrom_H * H_to_eta + + ! u-points + do j=js,je ; do I=Isq,Ieq ; do_I(I,j) = .False. ; enddo ; enddo + + do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), & + eta_u(I,j,nk+1), A_layer_prev(I,j), do_I(I,j)) + endif ; enddo ; enddo + + if (CS%answer_date < 20220806) then + do k=nk,1,-1 ; do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), & + eta_u(I,j,K), A_layer, do_I(I,j)) + if (eta_u(I,j,K) - eta_u(I,j,K+1) > 0.0) then + pbv%por_face_areaU(I,j,k) = (A_layer - A_layer_prev(I,j)) / (eta_u(I,j,K) - eta_u(I,j,K+1)) + else + pbv%por_face_areaU(I,j,k) = 0.0 + endif + A_layer_prev(I,j) = A_layer + endif ; enddo ; enddo ; enddo + else + do k=nk,1,-1 ; do j=js,je ; do I=Isq,Ieq ; if (do_I(I,j)) then + call calc_por_layer(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), & + eta_u(I,j,K), A_layer, do_I(I,j)) + if (eta_u(I,j,K) - (eta_u(I,j,K+1)+h_min) > 0.0) then + pbv%por_face_areaU(I,j,k) = min(1.0, (A_layer - A_layer_prev(I,j)) / (eta_u(I,j,K) - eta_u(I,j,K+1))) + else + pbv%por_face_areaU(I,j,k) = 0.0 ! use calc_por_interface() might be a better choice + endif + A_layer_prev(I,j) = A_layer + endif ; enddo ; enddo ; enddo + endif + + ! v-points + do J=Jsq,Jeq ; do i=is,ie; do_I(i,J) = .False. ; enddo ; enddo + + do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), & + eta_v(i,J,nk+1), A_layer_prev(i,J), do_I(i,J)) + endif ; enddo ; enddo + + if (CS%answer_date < 20220806) then + do k=nk,1,-1 ; do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), & + eta_v(i,J,K), A_layer, do_I(i,J)) + if (eta_v(i,J,K) - eta_v(i,J,K+1) > 0.0) then + pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev(i,J)) / (eta_v(i,J,K) - eta_v(i,J,K+1)) + else + pbv%por_face_areaV(i,J,k) = 0.0 + endif + A_layer_prev(i,J) = A_layer + endif ; enddo ; enddo ; enddo + else + do k=nk,1,-1 ; do J=Jsq,Jeq ; do i=is,ie ; if (do_I(i,J)) then + call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), & + eta_v(i,J,K), A_layer, do_I(i,J)) + if (eta_v(i,J,K) - (eta_v(i,J,K+1)+h_min) > 0.0) then + pbv%por_face_areaV(i,J,k) = min(1.0, (A_layer - A_layer_prev(i,J)) / (eta_v(i,J,K) - eta_v(i,J,K+1))) + else + pbv%por_face_areaV(i,J,k) = 0.0 ! use calc_por_interface() might be a better choice + endif + A_layer_prev(i,J) = A_layer + endif ; enddo ; enddo ; enddo + endif + + if (CS%debug) then + call uvchksum("Interface height used by porous barrier for layer weights", & + eta_u, eta_v, G%HI, haloshift=0) + call uvchksum("Porous barrier layer-averaged weights: por_face_area[UV]", & + pbv%por_face_areaU, pbv%por_face_areaV, G%HI, haloshift=0) + endif + + if (CS%id_por_face_areaU > 0) call post_data(CS%id_por_face_areaU, pbv%por_face_areaU, CS%diag) + if (CS%id_por_face_areaV > 0) call post_data(CS%id_por_face_areaV, pbv%por_face_areaV, CS%diag) + + call cpu_clock_end(id_clock_porous_barrier) +end subroutine porous_widths_layer + +!> subroutine to assign porous barrier widths at the layer interfaces +subroutine porous_widths_interface(h, tv, G, GV, US, pbv, CS, eta_bt) + ! Note: eta_bt is not currently used + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable + !! used to dilate the layer thicknesses + !! [H ~> m or kg m-2]. + type(porous_barrier_type), intent(inout) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_CS), intent(in) :: CS !< Control structure for porous barrier + + !local variables + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1) :: eta_u ! Layer interface height at u points [Z ~> m] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1) :: eta_v ! Layer interface height at v points [Z ~> m] + logical, dimension(SZIB_(G),SZJB_(G)) :: do_I ! Booleans for calculation at u or v points + ! updated while moving up layers + real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. + real :: h_neglect ! Negligible thicknesses, often [Z ~> m] + real :: dmask ! The depth below which porous barrier is not applied [Z ~> m] + integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq + + if (.not.CS%initialized) call MOM_error(FATAL, & + "MOM_Porous_barrier: Module must be initialized before it is used.") + + call cpu_clock_begin(id_clock_porous_barrier) + + is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke + Isq = G%IscB; Ieq = G%IecB; Jsq = G%JscB; Jeq = G%JecB + + if (CS%answer_date < 20220806) then + dmask = 0.0 + else + dmask = CS%mask_depth + endif + + call calc_eta_at_uv(eta_u, eta_v, CS%eta_interp, dmask, h, tv, G, GV, US) + + ! u-points + do j=js,je ; do I=Isq,Ieq + do_I(I,j) = .False. + if (G%porous_DavgU(I,j) < dmask) do_I(I,j) = .True. + enddo ; enddo + + if (CS%answer_date < 20220806) then + do K=1,nk+1 ; do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + call calc_por_interface(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), & + eta_u(I,j,K), pbv%por_layer_widthU(I,j,K), do_I(I,j)) + endif ; enddo ; enddo ; enddo + else + do K=1,nk+1 ; do j=js,je ; do I=Isq,Ieq ; if (do_I(I,j)) then + call calc_por_interface(G%porous_DminU(I,j), G%porous_DmaxU(I,j), G%porous_DavgU(I,j), & + eta_u(I,j,K), pbv%por_layer_widthU(I,j,K), do_I(I,j)) + endif ; enddo ; enddo ; enddo + endif + + ! v-points + do J=Jsq,Jeq ; do i=is,ie + do_I(i,J) = .False. + if (G%porous_DavgV(i,J) < dmask) do_I(i,J) = .True. + enddo ; enddo + + if (CS%answer_date < 20220806) then + do K=1,nk+1 ; do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + call calc_por_interface(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), & + eta_v(i,J,K), pbv%por_layer_widthV(i,J,K), do_I(i,J)) + endif ; enddo ; enddo ; enddo + else + do K=1,nk+1 ; do J=Jsq,Jeq ; do i=is,ie ; if (do_I(i,J)) then + call calc_por_interface(G%porous_DminV(i,J), G%porous_DmaxV(i,J), G%porous_DavgV(i,J), & + eta_v(i,J,K), pbv%por_layer_widthV(i,J,K), do_I(i,J)) + endif ; enddo ; enddo ; enddo + endif + + if (CS%debug) then + call uvchksum("Interface height used by porous barrier for interface weights", & + eta_u, eta_v, G%HI, haloshift=0) + call uvchksum("Porous barrier weights at the layer-interface: por_layer_width[UV]", & + pbv%por_layer_widthU, pbv%por_layer_widthV, G%HI, haloshift=0) + endif + + if (CS%id_por_layer_widthU > 0) call post_data(CS%id_por_layer_widthU, pbv%por_layer_widthU, CS%diag) + if (CS%id_por_layer_widthV > 0) call post_data(CS%id_por_layer_widthV, pbv%por_layer_widthV, CS%diag) + + call cpu_clock_end(id_clock_porous_barrier) +end subroutine porous_widths_interface + +subroutine calc_eta_at_uv(eta_u, eta_v, interp, dmask, h, tv, G, GV, US, eta_bt) + !variables needed to call find_eta + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic variable + !! used to dilate the layer thicknesses + !! [H ~> m or kg m-2]. + real, intent(in) :: dmask !< The depth shallower than which + !! porous barrier is not applied [Z ~> m] + integer, intent(in) :: interp !< eta interpolation method + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(out) :: eta_u !< Layer interface heights at u points [Z ~> m] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)+1), intent(out) :: eta_v !< Layer interface heights at v points [Z ~> m] + + ! local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: eta ! Layer interface heights [Z ~> m or 1/eta_to_m]. + real :: Z_to_eta, H_to_eta ! Unit conversion factors for eta. + real :: h_neglect ! Negligible thicknesses, often [Z ~> m] + integer :: i, j, k, nk, is, ie, js, je, Isq, Ieq, Jsq, Jeq + + is = G%isc; ie = G%iec; js = G%jsc; je = G%jec; nk = GV%ke + Isq = G%IscB; Ieq = G%IecB; Jsq = G%JscB; Jeq = G%JecB + + ! currently no treatment for using optional find_eta arguments if present + call find_eta(h, tv, G, GV, US, eta, halo_size=1) + + Z_to_eta = 1.0 + H_to_eta = GV%H_to_m * US%m_to_Z * Z_to_eta + h_neglect = GV%H_subroundoff * H_to_eta + + do K=1,nk+1 + do j=js,je ; do I=Isq,Ieq ; eta_u(I,j,K) = dmask ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; eta_v(i,J,K) = dmask ; enddo ; enddo + enddo + + select case (interp) + case (ETA_INTERP_MAX) ! The shallower interface height + do K=1,nk+1 + do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + eta_u(I,j,K) = max(eta(i,j,K), eta(i+1,j,K)) + endif ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + eta_v(i,J,K) = max(eta(i,j,K), eta(i,j+1,K)) + endif ; enddo ; enddo enddo - endif - enddo; enddo - - do J=JsdB,JedB; do i=isd,ied - if (G%porous_DavgV(i,J) < 0.) then - do K = nk+1,1,-1 - eta_s = max(eta(i,J,K), eta(i,J+1,K)) !take shallower layer height - if (eta_s <= G%porous_DminV(i,J)) then - pbv%por_layer_widthV(i,J,K) = 0.0 - A_layer_prev = 0.0 - if (K < nk+1) then - pbv%por_face_areaV(i,J,k) = 0.0; endif - else - call calc_por_layer(G%porous_DminV(i,J), G%porous_DmaxV(i,J), & - G%porous_DavgV(i,J), eta_s, w_layer, A_layer) - pbv%por_layer_widthV(i,J,K) = w_layer - if (k <= nk) then - if ((eta_s - eta_prev) > 0.0) then - pbv%por_face_areaV(i,J,k) = (A_layer - A_layer_prev)/& - (eta_s-eta_prev) - else - pbv%por_face_areaU(I,j,k) = 0.0; endif - endif - eta_prev = eta_s - A_layer_prev = A_layer - endif + case (ETA_INTERP_MIN) ! The deeper interface height + do K=1,nk+1 + do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + eta_u(I,j,K) = min(eta(i,j,K), eta(i+1,j,K)) + endif ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + eta_v(i,J,K) = min(eta(i,j,K), eta(i,j+1,K)) + endif ; enddo ; enddo enddo - endif - enddo; enddo + case (ETA_INTERP_ARITH) ! Arithmetic mean + do K=1,nk+1 + do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + eta_u(I,j,K) = 0.5 * (eta(i,j,K) + eta(i+1,j,K)) + endif ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + eta_v(i,J,K) = 0.5 * (eta(i,j,K) + eta(i,j+1,K)) + endif ; enddo ; enddo + enddo + case (ETA_INTERP_HARM) ! Harmonic mean + do K=1,nk+1 + do j=js,je ; do I=Isq,Ieq ; if (G%porous_DavgU(I,j) < dmask) then + eta_u(I,j,K) = 2.0 * (eta(i,j,K) * eta(i+1,j,K)) / (eta(i,j,K) + eta(i+1,j,K) + h_neglect) + endif ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; if (G%porous_DavgV(i,J) < dmask) then + eta_v(i,J,K) = 2.0 * (eta(i,j,K) * eta(i,j+1,K)) / (eta(i,j,K) + eta(i,j+1,K) + h_neglect) + endif ; enddo ; enddo + enddo + case default + call MOM_error(FATAL, "porous_widths::calc_eta_at_uv: "//& + "invalid value for eta interpolation method.") + end select +end subroutine calc_eta_at_uv -end subroutine por_widths +!> subroutine to calculate the profile fit (the three parameter fit from Adcroft 2013) +! of the open face area fraction below a certain depth (eta_layer) in a column +subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, A_layer, do_next) + real, intent(in) :: D_min !< minimum topographic height (deepest) [Z ~> m] + real, intent(in) :: D_max !< maximum topographic height (shallowest) [Z ~> m] + real, intent(in) :: D_avg !< mean topographic height [Z ~> m] + real, intent(in) :: eta_layer !< height of interface [Z ~> m] + real, intent(out) :: A_layer !< frac. open face area of below eta_layer [Z ~> m] + logical, intent(out) :: do_next !< False if eta_layer>D_max -!> subroutine to calculate the profile fit for a single layer in a column -subroutine calc_por_layer(D_min, D_max, D_avg, eta_layer, w_layer, A_layer) + ! local variables + real :: m, & ! convenience constant for fit [nondim] + zeta ! normalized vertical coordinate [nondim] - real, intent(in) :: D_min !< minimum topographic height [Z ~> m] - real, intent(in) :: D_max !< maximum topographic height [Z ~> m] - real, intent(in) :: D_avg !< mean topographic height [Z ~> m] - real, intent(in) :: eta_layer !< height of interface [Z ~> m] - real, intent(out) :: w_layer !< frac. open interface width of current layer [nondim] - real, intent(out) :: A_layer !< frac. open face area of current layer [Z ~> m] - !local variables - real m, a, & !convenience constant for fit [nondim] - zeta, & !normalized vertical coordinate [nondim] - psi, & !fractional width of layer between D_min and D_max [nondim] - psi_int !integral of psi from 0 to zeta + do_next = .True. + if (eta_layer <= D_min) then + A_layer = 0.0 + elseif (eta_layer > D_max) then + A_layer = eta_layer - D_avg + do_next = .False. + else + m = (D_avg - D_min) / (D_max - D_min) + zeta = (eta_layer - D_min) / (D_max - D_min) + if (m < 0.5) then + A_layer = (D_max - D_min) * ((1.0 - m) * zeta**(1.0 / (1.0 - m))) + elseif (m == 0.5) then + A_layer = (D_max - D_min) * (0.5 * zeta * zeta) + else + A_layer = (D_max - D_min) * (zeta - m + m * ((1.0 - zeta)**(1.0 / m))) + endif + endif +end subroutine calc_por_layer - !three parameter fit from Adcroft 2013 - m = (D_avg - D_min)/(D_max - D_min) - a = (1. - m)/m +!> subroutine to calculate the profile fit (the three parameter fit from Adcroft 2013) +! of the open interface fraction at a certain depth (eta_layer) in a column +subroutine calc_por_interface(D_min, D_max, D_avg, eta_layer, w_layer, do_next) + real, intent(in) :: D_min !< minimum topographic height (deepest) [Z ~> m] + real, intent(in) :: D_max !< maximum topographic height (shallowest) [Z ~> m] + real, intent(in) :: D_avg !< mean topographic height [Z ~> m] + real, intent(in) :: eta_layer !< height of interface [Z ~> m] + real, intent(out) :: w_layer !< frac. open interface width at eta_layer [nondim] + logical, intent(out) :: do_next !< False if eta_layer>D_max - zeta = (eta_layer - D_min)/(D_max - D_min) + ! local variables + real :: m, a, & ! convenience constant for fit [nondim] + zeta ! normalized vertical coordinate [nondim] + do_next = .True. if (eta_layer <= D_min) then w_layer = 0.0 - A_layer = 0.0 - elseif (eta_layer >= D_max) then + elseif (eta_layer > D_max) then w_layer = 1.0 - A_layer = eta_layer - D_avg + do_next = .False. else + m = (D_avg - D_min) / (D_max - D_min) + a = (1.0 - m) / m + zeta = (eta_layer - D_min) / (D_max - D_min) if (m < 0.5) then - psi = zeta**(1./a) - psi_int = (1.-m)*zeta**(1./(1.-m)) + w_layer = zeta**(1.0 / a) elseif (m == 0.5) then - psi = zeta - psi_int = 0.5*zeta*zeta + w_layer = zeta else - psi = 1. - (1. - zeta)**a - psi_int = zeta - m + m*((1-zeta)**(1/m)) + w_layer = 1.0 - (1.0 - zeta)**a endif - w_layer = psi - A_layer = (D_max - D_min)*psi_int endif +end subroutine calc_por_interface +subroutine porous_barriers_init(Time, US, param_file, diag, CS) + type(porous_barrier_CS), intent(inout) :: CS !< Module control structure + type(param_file_type), intent(in) :: param_file !< structure indicating parameter file to parse + type(time_type), intent(in) :: Time !< Current model time + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type -end subroutine calc_por_layer + ! local variables + character(len=40) :: mdl = "MOM_porous_barriers" ! This module's name. + character(len=20) :: interp_method ! String storing eta interpolation method + integer :: default_answer_date ! Global answer date + !> This include declares and sets the variable "version". +# include "version_variable.h" + + CS%initialized = .true. + CS%diag => diag + + call log_version(param_file, mdl, version, "", log_to_all=.true., layout=.false., & + debugging=.false.) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231) + call get_param(param_file, mdl, "PORBAR_ANSWER_DATE", CS%answer_date, & + "The vintage of the porous barrier weight function calculations. Values below "//& + "20220806 recover the old answers in which the layer averaged weights are not "//& + "strictly limited by an upper-bound of 1.0 .", default=default_answer_date) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "PORBAR_MASKING_DEPTH", CS%mask_depth, & + "If the effective average depth at the velocity cell is shallower than this "//& + "number, then porous barrier is not applied at that location. "//& + "PORBAR_MASKING_DEPTH is assumed to be positive below the sea surface.", & + units="m", default=0.0, scale=US%m_to_Z) + ! The sign needs to be inverted to be consistent with the sign convention of Davg_[UV] + CS%mask_depth = -CS%mask_depth + call get_param(param_file, mdl, "PORBAR_ETA_INTERP", interp_method, & + "A string describing the method that decides how the "//& + "interface heights at the velocity points are calculated. "//& + "Valid values are:\n"//& + "\t MAX (the default) - maximum of the adjacent cells \n"//& + "\t MIN - minimum of the adjacent cells \n"//& + "\t ARITHMETIC - arithmetic mean of the adjacent cells \n"//& + "\t HARMONIC - harmonic mean of the adjacent cells \n", & + default=ETA_INTERP_MAX_STRING) + select case (interp_method) + case (ETA_INTERP_MAX_STRING) ; CS%eta_interp = ETA_INTERP_MAX + case (ETA_INTERP_MIN_STRING) ; CS%eta_interp = ETA_INTERP_MIN + case (ETA_INTERP_ARITH_STRING) ; CS%eta_interp = ETA_INTERP_ARITH + case (ETA_INTERP_HARM_STRING) ; CS%eta_interp = ETA_INTERP_HARM + case default + call MOM_error(FATAL, "porous_barriers_init: Unrecognized setting "// & + "#define PORBAR_ETA_INTERP "//trim(interp_method)//" found in input file.") + end select + + CS%id_por_layer_widthU = register_diag_field('ocean_model', 'por_layer_widthU', diag%axesCui, Time, & + 'Porous barrier open width fraction (at the layer interfaces) of the u-faces', 'nondim') + CS%id_por_layer_widthV = register_diag_field('ocean_model', 'por_layer_widthV', diag%axesCvi, Time, & + 'Porous barrier open width fraction (at the layer interfaces) of the v-faces', 'nondim') + CS%id_por_face_areaU = register_diag_field('ocean_model', 'por_face_areaU', diag%axesCuL, Time, & + 'Porous barrier open area fraction (layer averaged) of U-faces', 'nondim') + CS%id_por_face_areaV = register_diag_field('ocean_model', 'por_face_areaV', diag%axesCvL, Time, & + 'Porous barrier open area fraction (layer averaged) of V-faces', 'nondim') + + id_clock_porous_barrier = cpu_clock_id('(Ocean porous barrier)', grain=CLOCK_MODULE) +end subroutine end module MOM_porous_barriers diff --git a/src/core/MOM_transcribe_grid.F90 b/src/core/MOM_transcribe_grid.F90 index 7ab15d542e..8f8da21ef3 100644 --- a/src/core/MOM_transcribe_grid.F90 +++ b/src/core/MOM_transcribe_grid.F90 @@ -76,6 +76,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%porous_DavgU(I,j) = dG%porous_DavgU(I+ido,j+jdo) - oG%Z_ref oG%mask2dCu(I,j) = dG%mask2dCu(I+ido,j+jdo) + oG%OBCmaskCu(I,j) = dG%OBCmaskCu(I+ido,j+jdo) oG%areaCu(I,j) = dG%areaCu(I+ido,j+jdo) oG%IareaCu(I,j) = dG%IareaCu(I+ido,j+jdo) enddo ; enddo @@ -92,6 +93,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) oG%porous_DavgV(i,J) = dG%porous_DavgV(i+ido,J+jdo) - oG%Z_ref oG%mask2dCv(i,J) = dG%mask2dCv(i+ido,J+jdo) + oG%OBCmaskCv(i,J) = dG%OBCmaskCv(i+ido,J+jdo) oG%areaCv(i,J) = dG%areaCv(i+ido,J+jdo) oG%IareaCv(i,J) = dG%IareaCv(i+ido,J+jdo) enddo ; enddo @@ -152,6 +154,7 @@ subroutine copy_dyngrid_to_MOM_grid(dG, oG, US) call pass_vector(oG%dxCu, oG%dyCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%dy_Cu, oG%dx_Cv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%mask2dCu, oG%mask2dCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) + call pass_vector(oG%OBCmaskCu, oG%OBCmaskCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%IareaCu, oG%IareaCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%IareaCu, oG%IareaCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(oG%geoLatCu, oG%geoLatCv, oG%Domain, To_All+Scalar_Pair, CGRID_NE) @@ -230,6 +233,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%porous_DavgU(I,j) = oG%porous_DavgU(I+ido,j+jdo) + oG%Z_ref dG%mask2dCu(I,j) = oG%mask2dCu(I+ido,j+jdo) + dG%OBCmaskCu(I,j) = oG%OBCmaskCu(I+ido,j+jdo) dG%areaCu(I,j) = oG%areaCu(I+ido,j+jdo) dG%IareaCu(I,j) = oG%IareaCu(I+ido,j+jdo) enddo ; enddo @@ -246,6 +250,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) dG%porous_DavgV(i,J) = oG%porous_DavgU(i+ido,J+jdo) + oG%Z_ref dG%mask2dCv(i,J) = oG%mask2dCv(i+ido,J+jdo) + dG%OBCmaskCv(i,J) = oG%OBCmaskCv(i+ido,J+jdo) dG%areaCv(i,J) = oG%areaCv(i+ido,J+jdo) dG%IareaCv(i,J) = oG%IareaCv(i+ido,J+jdo) enddo ; enddo @@ -307,6 +312,7 @@ subroutine copy_MOM_grid_to_dyngrid(oG, dG, US) call pass_vector(dG%dxCu, dG%dyCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%dy_Cu, dG%dx_Cv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%mask2dCu, dG%mask2dCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) + call pass_vector(dG%OBCmaskCu, dG%OBCmaskCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%IareaCu, dG%IareaCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%IareaCu, dG%IareaCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) call pass_vector(dG%geoLatCu, dG%geoLatCv, dG%Domain, To_All+Scalar_Pair, CGRID_NE) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index a6f9d79fe6..8279afa954 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -208,6 +208,8 @@ module MOM_variables real, pointer, dimension(:,:,:) :: & uh => NULL(), & !< Resolved zonal layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] vh => NULL(), & !< Resolved meridional layer thickness fluxes, [H L2 T-1 ~> m3 s-1 or kg s-1] + uh_smooth => NULL(), & !< Interface height smoothing induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] + vh_smooth => NULL(), & !< Interface height smoothing induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] uhGM => NULL(), & !< Isopycnal height diffusion induced zonal volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] vhGM => NULL() !< Isopycnal height diffusion induced meridional volume fluxes [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -309,15 +311,16 @@ module MOM_variables type(group_pass_type) :: pass_FA_uv !< Structure for face area group halo updates end type BT_cont_type - -!> pointers to grids modifying cell metric at porous barriers -type, public :: porous_barrier_ptrs - real, pointer, dimension(:,:,:) :: por_face_areaU => NULL() !< fractional open area of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_face_areaV => NULL() !< fractional open area of V-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthU => NULL() !< fractional open width of U-faces [nondim] - real, pointer, dimension(:,:,:) :: por_layer_widthV => NULL() !< fractional open width of V-faces [nondim] -end type porous_barrier_ptrs - +!> Container for grids modifying cell metric at porous barriers +! TODO: rename porous_barrier_type to porous_barrier_type +type, public :: porous_barrier_type + ! Each of the following fields has nz layers. + real, allocatable :: por_face_areaU(:,:,:) !< fractional open area of U-faces [nondim] + real, allocatable :: por_face_areaV(:,:,:) !< fractional open area of V-faces [nondim] + ! Each of the following fields is found at nz+1 interfaces. + real, allocatable :: por_layer_widthU(:,:,:) !< fractional open width of U-faces [nondim] + real, allocatable :: por_layer_widthV(:,:,:) !< fractional open width of V-faces [nondim] +end type porous_barrier_type contains diff --git a/src/core/_General_coordinate.dox b/src/core/_General_coordinate.dox index cdaf8a34ea..6effc4717b 100644 --- a/src/core/_General_coordinate.dox +++ b/src/core/_General_coordinate.dox @@ -1,76 +1,158 @@ -/*! \page General_Coordinate General coordinate equations +/*! \page General_Coordinate Generalized vertical coordinate equations -Transforming to a vertical coordinate \f$r(z,x,y,t)\f$, with \f$\dot{r} = \frac{\partial r}{\partial t}\f$ ... +The ocean equations discretized by MOM6 are formulated using +generalized vertical coordinates. Motivation for using generalized +vertical coordinates, and a full accounting of the ocean equations +written using these coordinates, can be found in Griffies, Adcroft and +Hallberg (2020) \cite Griffies_Adcroft_Hallberg2020. Here we provide +a brief summary. -The Boussinesq hydrostatic equations of motion in general-coordinate -\f$r\f$ are: +Consider a smooth function of space and time, \f$r(x,y,z,t)\f$, that +has a single-signed and non-zero vertical derivative known as the +specific thickness +\f{align} + \partial z/\partial r = (\partial r/\partial z)^{-1} = \mbox{specific thickness.} +\f} +The specific thickness measures the inverse vertical stratification of +the vertical coordinate surfaces. As so constrained, \f$r\f$ can +uniquely prescribe a positiion in the vertical. Consequently, the +ocean equations can be mapped one-to-one from geopotential vertical +coordinates to generalized vertical coordinate. Upon transforming to +\f$r\f$-coordinates, the material time derivative of \f$r\f$ appears +throughout the equations, playing the role of a pseudo-vertical +velocity, and we make use of the following shorthand for this +derivative +\f{align} +\dot{r} = D_{t} r. +\f} -\f{eqnarray} +The Boussinesq hydrostatic ocean equations take the following form using +generalized vertical coordinates (\f$r\f$-coordinates) +\f{align} \label{html:r-equations}\notag \\ -\rho_0 \left( \frac{\partial \mathbf{u}}{\partial t} + ( f + \zeta ) \, \hat{\mathbf{z}} \times \mathbf{u} + \dot{r} \, \frac{\partial \mathbf{u}}{\partial r} + \nabla_r \, K \right) &= -\nabla_r \, p - \rho \nabla_r \, \Phi + \boldsymbol{\mathcal{F}} -&\mbox{momentum} \label{eq:r-horz-momentum} \\ -\rho \, \frac{\partial \Phi}{\partial r} + \frac{\partial p}{\partial r} &= 0 -&\mbox{hydrostatic} \label{eq:r-hydrostatic-equation} \\ -\frac{\partial z_r }{\partial t} + \nabla_r \cdot \, \left( z_r \, \mathbf{u} \right) + \frac{\partial ( z_r \, \dot{r} ) }{\partial r} &= 0 -&\mbox{thickness} \label{eq:r-non-divergence} \\ -\frac{\partial ( \theta \, z_r ) }{\partial t} + \nabla_r \cdot \left( \theta z_r \, \mathbf{u} \right) + \frac{\partial ( \theta \, z_r \, \dot{r} )}{\partial r} &= z_r \boldsymbol{\mathcal{N}}_\theta^\gamma - \frac{\partial J_\theta^{(z)}}{\partial r} -&\mbox{potential temp} \label{eq:r-temperature-equation} \\ -\frac{\partial ( S \, z_r) }{\partial t} + \nabla_r \cdot \left( S \, z_r \, \mathbf{u} \right) + \frac{\partial ( S \, z_r \, \dot{r} )}{\partial r} &= z_r \boldsymbol{\mathcal{N}}_S^\gamma - \frac{\partial J_S^{(z)}}{\partial r} -&\mbox{salinity} \label{eq:r-salinity-equation} \\ -\rho &= \rho\left( S, \theta, -g \rho_0 z(r) \right) +\rho_o \left[ + \partial_{t} \mathbf{u} + (f + \zeta) \, \hat{\mathbf{z}} \times \mathbf{u} + + \dot{r} \, \partial_{r} \mathbf{u} \right] + &= -\nabla_r \, (p + \rho_{o} \, K) -\rho \nabla_r \Phi + \rho_{o} \, \mathbf{\mathcal{F}} + &\mbox{horizontal momentum} +\label{eq:r-horz-momentum} +\\ +\rho \, \partial_{r} \Phi + \partial_{r}p + &= 0 +&\mbox{hydrostatic} +\label{eq:r-hydrostatic-equation} +\\ + \partial_{t}( z_r) ++ \nabla_r \cdot ( z_r \, \mathbf{u} ) ++ \partial_{r} ( z_r \, \dot{r} ) +&= 0 +&\mbox{specific thickness} +\label{eq:r-non-divergence} +\\ + \partial_{t} ( \theta \, z_r ) ++ \nabla_r \cdot ( \theta z_r \, \mathbf{u} ) ++ \partial_{r} ( \theta \, z_r \, \dot{r} ) +&= z_r \mathbf{\mathcal{N}}_\theta^\gamma +- \partial_{r} J_\theta^{(z)} +&\mbox{potential/Conservative temp} +\label{eq:r-temperature-equation} +\\ +\partial_{t} ( S \, z_r) ++ \nabla_r \cdot ( S \, z_r \, \mathbf{u} ) ++ \partial_{r} ( S \, z_r \, \dot{r} ) +&= z_r \mathbf{\mathcal{N}}_S^\gamma +- \partial_{r} J_S^{(z)} +&\mbox{salinity} +\label{eq:r-salinity-equation} +\\ +\rho &= \rho( S, \theta, -g \rho_0 z ) &\mbox{equation of state.} \f} +The time derivatives appearing in these equations are computed with +the generalized vertical coordinate fixed rather than the +geopotential. It is a common misconception that the horizontal +velocity, \f$\mathbf{u}\f$, is rotated to align with constant \f$r\f$ +surfaces. Such is not the case. Rather, the horizontal velocity, +\f$\mathbf{u}\f$, is precisely the same horizontal velocity used with +geopotential coordinates. However, its evolution has here been +formulated using generalized vertical coordinates. -The time derivatives are now computed with the generalized vertical -coordinate fixed rather than the geopotential. We introduced the -specific thickness, \f$z_r = \partial z/\partial r\f$, which measures the -inverse vertical stratification of the vertical coordinate surfaces. - - Similar to \cite bleck2002, MOM6 is discretized in the vertical by - integrating between surfaces of \f$r\f$ to yield layer equations where the - layer thickness is \f$h = \int z_r dr\f$ and variables are treated as finite - volume averages over each layer: - -\f{eqnarray} -\label{html:h-equations}\notag \\ -\rho_0 \left( \frac{\partial \mathbf{u}}{\partial t} + \frac{( f + \zeta )}{h} \, +As a finite volume model, MOM6 is discretized in the vertical by +integrating between surfaces of constant \f$r\f$. The layer thickness +is a basic term appearing in these equations, which results from +integrating the specific thickness over a layer +\f{align} +h = \int z_r \, \mathrm{d}r. +\f} +Correspondingly, the model variables are treated as finite volume +averages over each layer, with full accounting of this finite volume +approach presented in Griffies, Adcroft and Hallberg (2020) +\cite Griffies_Adcroft_Hallberg2020, and with the semi-discrete model +ocean model equations written as follows. +\f{align} +\rho_0 +\left[ \frac{\partial \mathbf{u}}{\partial t} + \frac{( f + \zeta )}{h} \, \hat{\mathbf{z}} \times h \, \mathbf{u} + \underbrace{ \dot{r} \, -\frac{\partial \mathbf{u}}{\partial r} } + \nabla_r K \right) &= -\nabla_r \, p - -\rho \nabla_r \, \Phi + \boldsymbol{\mathcal{F}} -&\mbox{momentum} \label{eq:h-horz-momentum} \\ -\rho \, \delta_r \Phi + \delta_r p &= 0 -&\mbox{hydrostatic} \label{eq:h-hydrostatic-equation} \\ +\frac{\partial \mathbf{u}}{\partial r} } +\right] +&= -\nabla_r \, (p + \rho_{0} \, K) - +\rho \nabla_r \, \Phi + \mathbf{\mathcal{F}} +&\mbox{horizontal momentum} +\label{eq:h-horz-momentum} +\\ +\rho \, \delta_r \Phi + \delta_r p +&= 0 +&\mbox{hydrostatic} +\label{eq:h-hydrostatic-equation} +\\ \frac{\partial h}{\partial t} + \nabla_r \cdot \left( h \, \mathbf{u} \right) + -\underbrace{ \delta_r ( z_r \dot{r} ) } &= 0 -&\mbox{thickness} \label{eq:h-thickness-equation} \\ +\underbrace{ \delta_r ( z_r \dot{r} ) } + &= 0 +&\mbox{thickness} +\label{eq:h-thickness-equation} +\\ \frac{\partial ( \theta \, h )}{\partial t} + \nabla_r \cdot \left( \theta h \, -\mathbf{u} \right) + \underbrace{ \delta_r ( \theta \, z_r \dot{r} ) } &= -h \boldsymbol{\mathcal{N}}_\theta^\gamma - \delta_r J_\theta^{(z)} -&\mbox{potential temp} \label{eq:h-temperature-equation} \\ +\mathbf{u} \right) + \underbrace{ \delta_r ( \theta \, z_r \dot{r} ) } +&= +h \mathbf{\mathcal{N}}_\theta^\gamma - \delta_r J_\theta^{(z)} +&\mbox{potential/Conservative temp} +\label{eq:h-temperature-equation} +\\ \frac{\partial ( S \, h )}{\partial t} + \nabla_r \cdot \left( S \, h \, -\mathbf{u} \right) + \underbrace{ \delta_r ( S \, z_r \dot{r} ) } &= -h \boldsymbol{\mathcal{N}}_S^\gamma - \delta_r J_S^{(z)} -&\mbox{salinity} \label{eq:h-salinity-equation} \\ +\mathbf{u} \right) + \underbrace{ \delta_r ( S \, z_r \dot{r} ) } +&= +h \mathbf{\mathcal{N}}_S^\gamma - \delta_r J_S^{(z)} +&\mbox{salinity} +\label{eq:h-salinity-equation} +\\ \rho &= \rho\left( S, \theta, -g \rho_0 z(r) \right) &\mbox{equation of state,} \label{eq:h-equation-of-state} \f} - -where \f$\delta_{r} = \mathrm{d}r \, (\partial/\partial r)\f$ is the discrete -vertical difference operator. The pressure gradient accelerations -in the momentum equation \eqref{eq:h-horz-momentum,h-equations,momentum} are written in +where +\f{align} +\delta_{r} = \mathrm{d}r \, (\partial/\partial r) +\f} +is the discrete vertical difference operator. The pressure gradient +accelerations in the momentum equation are written in continuous-in-the-vertical form for brevity; the exact discretization -is detailed in \cite adcroft2008. The MOM6 time-stepping algorithm -integrates the above layer-averaged equations forward allowing the -vertical grid to follow the motion, i.e. \f$\dot{r}=0\f$, so that the underbraced -terms are dropped. This approach is generally known as the Lagrangian -method but here the Lagrangian method is used only in the vertical -direction. After each Lagrangian step, a remap step is applied that -generates a new vertical grid of the user's choosing. The ocean state is -then mapped from the old to the new grid. The physical state is not meant -to change during the remap step, yet truncation errors make remapping -imperfect. We employ high-order accurate reconstructions to minimize -errors introduced during the remap step (\cite white2008, \cite white2009). The -connection between time-stepping and remapping is described in -section \ref ALE_Timestep. +is detailed in \cite adcroft2008 and +\cite Griffies_Adcroft_Hallberg2020. The \f$1/h\f$ and \f$h\f$ appearing in +the horizontal momentum equation are carefully handled in the code to +ensure proper cancellation even when the layer thickness goes to zero +i.e., l'Hospital's rule is respected. + +The MOM6 time-stepping algorithm integrates the above layer-averaged +equations forward in time allowing the vertical grid to follow the +motion, i.e. \f$\dot{r}=0\f$, so that the underbraced terms are +dropped. This approach is generally known as a Lagrangian method, with +the Lagrangian approach in MOM6 limited to the vertical +direction. After each Lagrangian step, a regrid step is applied that +generates a new vertical grid of the user's choosing. The ocean state +is then remapped from the old to the new grid. The physical state is +not meant to change during the remap step, yet truncation errors make +remapping imperfect. We employ high-order accurate reconstructions to +minimize errors introduced during the remap step (\cite white2008, +\cite white2009). The connection between time-stepping and remapping +is described in section \ref ALE_Timestep. */ diff --git a/src/core/_Governing.dox b/src/core/_Governing.dox index 646ba52c09..466e9d957e 100644 --- a/src/core/_Governing.dox +++ b/src/core/_Governing.dox @@ -1,71 +1,176 @@ /*! \page Governing_Equations Governing Equations -The Boussinesq hydrostatic equations of motion in height coordinates are - -\f{eqnarray} D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \times \boldsymbol{u} + \frac{\rho}{\rho_o} \boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\mathcal{F}} &\mbox{ momentum} \\ - \rho \, \frac{\partial \Phi}{\partial z} + \frac{\partial p}{\partial z} &= 0 &\mbox{ hydrostatic} \\ - \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \frac{\partial w}{\partial z} &= 0 &\mbox{ thickness} \\ - D_t \theta &= \boldsymbol{\mathcal{N}}_\theta^\gamma - \frac{\partial J_\theta^{(z)}}{\partial z} &\mbox{ potential temp} \\ - D_t S &= \boldsymbol{\mathcal{N}}_S^\gamma - \frac{\partial J_S^{(z)}}{\partial z} &\mbox{ salinity} \\ - \rho &= \rho(S, \theta, z) &\mbox{ equation of state.} +MOM6 is a hydrostatic ocean circulation model that time steps either +the non-Boussinesq ocean equations (where the flow velocity is +divergent: \f$\nabla \cdot \mathbf{v} \ne 0\f$), or the Boussinesq +ocean equations (where velocity is non-divergent: \f$\nabla \cdot +\mathbf{v} = 0\f$). We here display the Boussinesq version since +it is most commonly used (as of 2022). We start by casting the +equations in geopotentiial coordinates prior to transforming to the +generalized vertical coordinates used by MOM6. A more thorough +discussion of these equations, and their finite volume realization +appropriate for MOM6, can be found in Griffies, Adcroft and Hallberg (2020) +\cite Griffies_Adcroft_Hallberg2020. + +The hydrostatic Boussinesq ocean equations, written using geopotential +vertical coordinates, are given by +\f{align} + \rho_o \left[ + D_t \mathbf{u} + f \hat{\mathbf{z}} \times \mathbf{u} + \right] + &= -\rho \, \nabla_z \Phi - \nabla_z p + + \rho_o \, \mathbf{\mathcal{F}} + &\mbox{horizontal momentum} +\\ + \rho \, \partial_{z} \Phi + \partial_{z} p &= 0 &\mbox{hydrostatic} +\\ + \nabla_z \cdotp \mathbf{u} + \partial_{z} w + &= 0 + &\mbox{continuity} +\\ + D_t \theta &= \mathbf{\mathcal{N}}_\theta^\gamma + - \partial_{z} J_\theta^{(z)} + &\mbox{potential or Conservative temp} + \\ + D_t S &= \mathbf{\mathcal{N}}_S^\gamma +- \partial_{z} J_S^{(z)} + &\mbox{salinity} +\\ + \rho &= \rho(S, \theta, z) &\mbox{ equation of state} +\\ + \mathbf{v} &= \mathbf{u} + \hat{\mathbf{z}} \, w &\mbox{velocity field.} \f} -where notation is described in \ref Notation, \f$\boldsymbol{\mathcal{F}}\f$ represents the accelerations due to -the divergence of stresses including those provided through boundary interactions. - -The prognostic thermodynamic variables are potential temperature, -\f$\theta\f$, and salinity \f$S\f$, which are related to in situ density -\f$\rho\f$ through the \cite wright1997 equation of state. In the potential -temperature and salinity equations, fluxes due to diabatic, vertically -oriented processes are indicated by \f$J^{(z)}\f$. The tendency due to the -convergence of fluxes oriented along neutral directions is indicated by -\f$\boldsymbol{\mathcal{N}}^\gamma\f$. Our implementation of this neutral -diffusion parameterization is detailed in Shao et al. (personal comm.) - -The total derivative is - -\f{eqnarray} D_t & \equiv \frac{\partial}{\partial t} + \boldsymbol{v} \cdotp \boldsymbol{\nabla} \\ - &= \frac{\partial}{\partial t} + \boldsymbol{u} \cdotp \boldsymbol{\nabla}_z + w \frac{\partial}{\partial z}. +The acceleration term, \f$\mathbf{\mathcal{F}}\f$, in the +horizontal momentum equation includes the acceleration due to the +divergence of internal frictional stresses as well as from bottom and +surface boundary stresses. Other notation is described in \ref +Notation. + +The prognostic temperature, \f$\theta\f$, is either potential +temperature or Conservative Temperature, depending on the chosen +equation of state, and \f$S\f$ is the salinity. We generally follow +the discussion of \cite McDougall_etal_2021 for how to interpret the +prognostic temperature and salinity in ocean models. MOM6 has +historically used the Wright (1997) \cite wright1997 equation of state +to compute the in situ density, \f$\rho\f$. However, there +are other options as documented in \ref Equation_of_State. In the +potential temperature and salinity equations, fluxes due to diabatic +processes are indicated by \f$J^{(z)}\f$. Tendencies due to the +convergence of fluxes oriented along neutral directions are indicated +by \f$\mathbf{\mathcal{N}}^\gamma\f$, with our implementation of +neutral diffusion detailed in Shao et al (2020) +\cite Shao_etal_2020. + +The total or material time derivative operator is given by +\f{align} + D_t &\equiv \partial_{t} + \mathbf{v} \cdotp \nabla + \\ + &= \partial_{t} + \mathbf{u} \cdotp \nabla_z + w \, \partial_{z}, \f} - -The non-divergence of flow allows a total derivative to be re-written in flux form: - -\f{eqnarray} D_t \theta &= \frac{\partial}{\partial t} + \boldsymbol{\nabla} \cdotp ( \boldsymbol{v} \theta ) \\ - &= \frac{\partial}{\partial t} + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \frac{\partial ( w \theta )}{\partial z}. +where the second equality explosed the horizontal and vertical terms. Using the non-divergence condition +on the three-dimensional velocity allows us to write the material time derivative of an arbitrary scalar field, +\f$\psi\f$, into a flux-form equation +\f{align} D_t \psi &= ( \partial_{t} + \mathbf{u} \cdotp \nabla) \, \psi + \\ + &= \partial_{t} \psi + \nabla \cdotp (\mathbf{v} \, \psi) +\\ + &= \partial_{t} \psi + \nabla_z \cdotp ( \mathbf{u} \, \psi) + \partial_{z} ( w \, \psi). \f} - -The above equations of motion can thus be written as: - -\f{eqnarray} D_t \boldsymbol{u} + f \widehat{\boldsymbol{k}} \times \boldsymbol{u} + \frac{\rho}{\rho_o}\boldsymbol{\nabla}_z \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla}_z p &= \boldsymbol{\mathcal{F}} &\mbox{ momentum}\\ - \rho \, \frac{\partial \Phi}{\partial z} + \frac{\partial p}{\partial z} &= 0 &\mbox{ hydrostatic} \\ - \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \frac{\partial w}{\partial z} &= 0 &\mbox{ thickness} \\ - \frac{\partial \theta}{\partial t} + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \frac{\partial ( w \theta )}{\partial z} &= \boldsymbol{\mathcal{N}}_\theta^\gamma - \frac{\partial J_\theta^{(z)}}{\partial z} &\mbox{ potential temp} \\ - \frac{\partial S}{\partial t} + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} S ) + \frac{\partial ( w S )}{\partial z} &= \boldsymbol{\mathcal{N}}_S^\gamma - \frac{\partial J_S^{(z)}}{\partial z} &\mbox{ salinity} \\ - \rho &= \rho(S, \theta, z) &\mbox{ equation of state.} +Discretizing the flux-form scalar equations means that fluxes +transferring scalars between grid cells act in a conservative manner. +Consequently, the domain integrated scalar (e.g., total seawater volume, total +salt content, total potential enthalpy) is affected only via surface and bottom +boundary transport. Such global conservation properties are +maintained by MOM6 to within computational roundoff, with this level +of precision found to be essential for using MOM6 to study +climate. Making use of the flux-form scalar conservation equations +brings the model equations to the form +\f{align} + \rho_o \left[ + D_t \mathbf{u} + f \hat{\mathbf{z}} \times \mathbf{u} + \right] + &= -\rho \, \nabla_z \Phi - \nabla_z p + + \rho_o \, \mathbf{\mathcal{F}} + &\mbox{horizontal momentum} +\\ + \rho \, \partial_{z} \Phi + \partial_{z} p &= 0 &\mbox{hydrostatic} +\\ + \nabla_z \cdotp \mathbf{u} + \partial_{z} w + &= 0 + &\mbox{continuity} +\\ +\partial_{t} \theta + \nabla_z \cdotp (\mathbf{u} \, \theta) + \partial_{z} (w \, \theta) +&= \mathbf{\mathcal{N}}_\theta^\gamma - \partial_{z} J_\theta^{(z)} +&\mbox{potential or Conservative temp} +\\ +\partial_{t} S + \nabla_z \cdotp (\mathbf{u} \, S) + \partial_{z}(w \, S) +&= \mathbf{\mathcal{N}}_S^\gamma -\partial_{z} J_S^{(z)} + &\mbox{salinity} +\\ +\rho &= \rho(S, \theta, z) &\mbox{equation of state.} \f} -\section vector_invariant_eqns Vector Invariant Equations - -MOM6 solves the momentum equations written in vector-invariant form. - -A vector identity allows the total derivative of velocity to be written in the vector-invariant form: - -\f{eqnarray} D_t \boldsymbol{u} &= \partial_t \boldsymbol{u} + \boldsymbol{v} \cdotp \boldsymbol{\nabla} \boldsymbol{u} \\ - &= \partial_t \boldsymbol{u} + \boldsymbol{u} \cdotp \boldsymbol{\nabla}_z \boldsymbol{u} + w \partial_z \boldsymbol{u} \\ - &= \partial_t \boldsymbol{u} + \left( \boldsymbol{\nabla} - \times \boldsymbol{u} \right) \times \boldsymbol{v} + \boldsymbol{\nabla} \underbrace{\frac{1}{2} \left|\boldsymbol{u}\right|^2}_{\equiv K} . +\section vector_invariant_eqns Vector invariant velocity equation + +MOM6 time steps the horizontal velocity equation in its +vector-invariant form. To derive this equation we make use of the +following vector identity +\f{align} + D_t \mathbf{u} + &= + \partial_t \mathbf{u} + \mathbf{v} \cdotp \nabla \mathbf{u} + \\ + &= + \partial_t \mathbf{u} + \mathbf{u} \cdotp \nabla_z \mathbf{u} + w \partial_z \mathbf{u} + \\ + &= + \partial_t \mathbf{u} + \left( \nabla \times \mathbf{u} \right) \times \mathbf{v} + + \nabla \left|\mathbf{u}\right|^2/2 + \\ + &= + \partial_t \mathbf{u} + w \, \partial_{z} \mathbf{u} + + \zeta \, \hat{\mathbf{z}} \times \mathbf{u} + \nabla_{z} K, \f} - -The flux-form equations of motion in height coordinates can thus be written succinctly as: - -\f{eqnarray} \partial_t \boldsymbol{u} + \left( f \widehat{\boldsymbol{k}} + - \boldsymbol{\nabla} \times \boldsymbol{u} \right) \times \boldsymbol{v} + \boldsymbol{\nabla} K - + \frac{\rho}{\rho_o} \boldsymbol{\nabla} \Phi + \frac{1}{\rho_o} \boldsymbol{\nabla} p &= \boldsymbol{\mathcal{F}} &\mbox{ momentum} \\ - \boldsymbol{\nabla}_z \cdotp \boldsymbol{u} + \partial_z w &= 0 &\mbox{ thickness} \\ - \partial_t \theta + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} \theta ) + \partial_z ( w \theta ) &= \boldsymbol{\mathcal{N}}_\theta^\gamma - \frac{\partial J_\theta^{(z)}}{\partial z} &\mbox{ potential temp} \\ - \partial_t S + \boldsymbol{\nabla}_z \cdotp ( \boldsymbol{u} S ) + \partial_z ( w S ) &= \boldsymbol{\mathcal{N}}_S^\gamma - \frac{\partial J_S^{(z)}}{\partial z} &\mbox{ salinity} \\ - \rho &= \rho(S, \theta, z) &\mbox{ equation of state} +where we introduced the vertical component to the relative vorticity +\f{align} + \zeta = \hat{\mathbf{z}} \cdot (\nabla \times \mathbf{u}) + = \partial_{x}v - \partial_{y} u, +\label{eq:relative-vorticity-z} +\f} +as well as the kinetic energy per mass contained in the horizontal flow +\f{align} + K = (u^{2} + v^{2})/2. +\label{eq:kinetic-energy-per-mass} +\f} +It is just the horizontal kinetic energy per mass that appears when +making the hydrostatic approximation, whereas a non-hydrostatic fluid +(such as the MITgcm) includes the contribution from vertical motion. With +these identities we are led to the MOM6 flux-form equations of motion in +geopotential coordinates +\f{align} + \rho_{o} \left[ + \partial_t \mathbf{u} + w \, \partial_{z} \mathbf{u} + + (f + \zeta) \hat{\mathbf{z}} \times \mathbf{u} + \right] + &= -\nabla_{z} (p + K) - \rho \, \nabla_{z} \Phi + \rho_{o} \, \mathbf{\mathcal{F}} + &\mbox{vector-inv horz velocity} +\\ + \rho \, \partial_{z} \Phi + \partial_{z} p &= 0 &\mbox{hydrostatic} +\\ + \nabla_z \cdotp \mathbf{u} + \partial_{z} w + &= 0 + &\mbox{continuity} + \\ + \partial_t \theta + \nabla_z \cdotp ( \mathbf{u} \, \theta ) + \partial_z ( w \, \theta ) + &= \mathbf{\mathcal{N}}_\theta^\gamma - \partial_{z} J_\theta^{(z)} + &\mbox{potential/Cons temp} + \\ + \partial_t S + \nabla_z \cdotp ( \mathbf{u} \, S ) + \partial_z (w \, S) + &= \mathbf{\mathcal{N}}_S^\gamma - \partial_{z} J_S^{(z)} + &\mbox{salinity} + \\ + \rho &= \rho(S, \theta, z) &\mbox{equation of state.} \f} -where the horizontal momentum equations and vertical hydrostatic balance equation have been written as a single three-dimensional equation. */ diff --git a/src/core/_Notation.dox b/src/core/_Notation.dox index faecb3b258..b91baac5fe 100644 --- a/src/core/_Notation.dox +++ b/src/core/_Notation.dox @@ -2,34 +2,62 @@ \section Symbols Symbols for variables -\f$z\f$ refers to elevation (or height), increasing upward so that for much of the ocean \f$z\f$ is negative. +\f$z\f$ refers to geopotential elevation (or height), increasing +upward and with \f$z=0\f$ defining the resting ocean surface. Much of +the ocean has \f$z < 0\f$. -\f$x\f$ and \f$y\f$ are the Cartesian horizontal coordinates. +\f$x\f$ and \f$y\f$ are the Cartesian horizontal coordinates. MOM6 + uses generalized orthogonal curvilinear horizontal + coordinates. However, the equations are simpler to write using + Cartesian coordinates, and it is very straightforward to generalize + the horizontal coordinates using the methods in Chapters 20 and 21 of + \cite SMGbook. -\f$\lambda\f$ and \f$\phi\f$ are the geographic coordinates on a sphere (longitude and latitude respectively). +\f$\lambda\f$ and \f$\phi\f$ are the geographic coordinates on a +sphere (longitude and latitude, respectively). -Horizontal components of velocity are indicated by \f$u\f$ and \f$v\f$ and vertical component by \f$w\f$. +Horizontal components of velocity are indicated by \f$u\f$ and \f$v\f$ +and vertical component by \f$w\f$. -\f$p\f$ is pressure and \f$\Phi\f$ is geo-potential: +\f$p\f$ is the hydrostatic pressure. - \f[ \Phi = g z .\f] +\f$\Phi\f$ is the geopotential. In the absence of tides, the +geopotential is given by \f$\Phi = g z,\f$ whereas more general +expressions hold when including astronomical tide forcing. -The thermodynamic state variables are usually salinity, \f$S\f$, and potential temperature, \f$\theta\f$ or the absolute salinity and conservative temperature, depending on the equation of state. \f$\rho\f$ is in-situ density. +The thermodynamic state variables can be salinity, \f$S\f$, and +potential temperature, \f$\theta\f$. Alternatively, one can choose +the Conservative Temperature if using the TEOS10 equation of state +from \cite TEOS2010. -\section vector_notation Vector notation - -The three-dimensional velocity vector is denoted \f$\boldsymbol{v}\f$ +\f$\rho\f$ is the in-situ density computed as a function +\f$\rho(S,\theta,p)\f$ for non-Boussinesq ocean or +\f$\rho(S,\theta,p=-g \, \rho_o \, z)\f$ for Boussinesq ocean. See +Young (2010) \cite Young2010 or Section 2.4 of Vallis (2017) +\cite GVbook for reasoning behind the simplified pressure +used in the Boussinesq equation of state. - \f[\boldsymbol{v} = \boldsymbol{u} + \widehat{\boldsymbol{k}} w ,\f] -where \f$\widehat{\boldsymbol{k}}\f$ is the unit vector pointed in the upward vertical direction and \f$\boldsymbol{u} = (u, v, 0)\f$ is the horizontal -component of velocity normal to the vertical. -The gradient operator without a suffix is three dimensional: - - \f[\boldsymbol{\nabla} = ( \boldsymbol{\nabla}_z, \partial_z ) .\f] +\section vector_notation Vector notation -but a suffix indicates a lateral gradient along a surface of constant property indicated by the suffix: +The three-dimensional velocity vector is denoted \f$\mathbf{v}\f$ +and it is decomposed into its horizontal and vertical components according to +\f{align} +\mathbf{v} + = \mathbf{u} + \hat{\mathbf{z}} \, w + = \hat{\mathbf{x}} \, u + \hat{\mathbf{y}} \, v + \hat{\mathbf{z}} \, w, + \f} +where \f$\hat{\mathbf{z}}\f$ is the unit vector pointed in the +upward vertical direction and \f$\mathbf{u} = (u, v, 0)\f$ is the +horizontal component of velocity normal to the vertical. + +The three-dimensional gradient operator is denoted \f$\nabla\f$, and it is decomposed into +its horizontal and vertical components according to +\f{align} +\nabla + = \nabla_z + \hat{\mathbf{z}} \, \partial_z + = \hat{\mathbf{x}} \, \partial_x + \hat{\mathbf{y}} \, \partial_y + \hat{\mathbf{z}} \, \partial_z. + \f} - \f[\boldsymbol{\nabla}_z = \left( \left. \partial_x \right|_z, \left. \partial_y \right|_z, 0 \right) .\f] */ diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index e0441cac2e..e686261fdf 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -71,6 +71,7 @@ subroutine find_obsolete_params(param_file) call obsolete_real(param_file, "VSTAR_SCALE_COEF") call obsolete_real(param_file, "ZSTAR_RIGID_SURFACE_THRESHOLD") + call obsolete_logical(param_file, "HENYEY_IGW_BACKGROUND_NEW") ! Test for inconsistent parameter settings. split = .true. ; test_logic = .false. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index bfc6f1b1a4..60c30d8e94 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -87,6 +87,7 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & mask2dCu, & !< 0 for boundary points and 1 for ocean points on the u grid [nondim]. + OBCmaskCu, & !< 0 for boundary or OBC points and 1 for ocean points on the u grid [nondim]. geoLatCu, & !< The geographic latitude at u points [degrees of latitude] or [m]. geoLonCu, & !< The geographic longitude at u points [degrees of longitude] or [m]. dxCu, & !< dxCu is delta x at u points [L ~> m]. @@ -99,6 +100,7 @@ module MOM_dyn_horgrid real, allocatable, dimension(:,:) :: & mask2dCv, & !< 0 for boundary points and 1 for ocean points on the v grid [nondim]. + OBCmaskCv, & !< 0 for boundary or OBC points and 1 for ocean points on the v grid [nondim]. geoLatCv, & !< The geographic latitude at v points [degrees of latitude] or [m]. geoLonCv, & !< The geographic longitude at v points [degrees of longitude] or [m]. dxCv, & !< dxCv is delta x at v points [L ~> m]. @@ -110,13 +112,13 @@ module MOM_dyn_horgrid areaCv !< The areas of the v-grid cells [L2 ~> m2]. real, allocatable, dimension(:,:) :: & - porous_DminU, & !< minimum topographic height of U-face [Z ~> m] - porous_DmaxU, & !< maximum topographic height of U-face [Z ~> m] + porous_DminU, & !< minimum topographic height (deepest) of U-face [Z ~> m] + porous_DmaxU, & !< maximum topographic height (shallowest) of U-face [Z ~> m] porous_DavgU !< average topographic height of U-face [Z ~> m] real, allocatable, dimension(:,:) :: & - porous_DminV, & !< minimum topographic height of V-face [Z ~> m] - porous_DmaxV, & !< maximum topographic height of V-face [Z ~> m] + porous_DminV, & !< minimum topographic height (deepest) of V-face [Z ~> m] + porous_DmaxV, & !< maximum topographic height (shallowest) of V-face [Z ~> m] porous_DavgV !< average topographic height of V-face [Z ~> m] real, allocatable, dimension(:,:) :: & @@ -250,6 +252,8 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) allocate(G%mask2dCu(IsdB:IedB,jsd:jed), source=0.0) allocate(G%mask2dCv(isd:ied,JsdB:JedB), source=0.0) allocate(G%mask2dBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%OBCmaskCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%OBCmaskCv(isd:ied,JsdB:JedB), source=0.0) allocate(G%geoLatT(isd:ied,jsd:jed), source=0.0) allocate(G%geoLatCu(IsdB:IedB,jsd:jed), source=0.0) allocate(G%geoLatCv(isd:ied,JsdB:JedB), source=0.0) @@ -331,6 +335,7 @@ subroutine rotate_dyn_horgrid(G_in, G, US, turns) call rotate_array_pair(G_in%dx_Cv, G_in%dy_Cu, turns, G%dx_Cv, G%dy_Cu) call rotate_array_pair(G_in%mask2dCu, G_in%mask2dCv, turns, G%mask2dCu, G%mask2dCv) + call rotate_array_pair(G_in%OBCmaskCu, G_in%OBCmaskCv, turns, G%OBCmaskCu, G%OBCmaskCv) call rotate_array_pair(G_in%areaCu, G_in%areaCv, turns, G%areaCu, G%areaCv) call rotate_array_pair(G_in%IareaCu, G_in%IareaCv, turns, G%IareaCu, G%IareaCv) @@ -501,8 +506,8 @@ subroutine destroy_dyn_horgrid(G) deallocate(G%areaCu) ; deallocate(G%IareaCu) deallocate(G%areaCv) ; deallocate(G%IareaCv) - deallocate(G%mask2dT) ; deallocate(G%mask2dCu) - deallocate(G%mask2dCv) ; deallocate(G%mask2dBu) + deallocate(G%mask2dT) ; deallocate(G%mask2dCu) ; deallocate(G%OBCmaskCu) + deallocate(G%mask2dCv) ; deallocate(G%OBCmaskCv) ; deallocate(G%mask2dBu) deallocate(G%geoLatT) ; deallocate(G%geoLatCu) deallocate(G%geoLatCv) ; deallocate(G%geoLatBu) diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 6eba9be727..a76e96499f 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -4,12 +4,12 @@ module MOM_restart ! This file is part of MOM6. See LICENSE.md for the license. use MOM_checksums, only : chksum => rotated_field_chksum -use MOM_domains, only : PE_here, num_PEs +use MOM_domains, only : PE_here, num_PEs, AGRID, BGRID_NE, CGRID_NE use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE, is_root_pe use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_io, only : create_file, file_type, fieldtype, file_exists, open_file, close_file -use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum +use MOM_io, only : MOM_read_data, read_data, MOM_write_field, read_field_chksum, field_exists use MOM_io, only : get_file_info, get_file_fields, get_field_atts, get_file_times use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE @@ -22,7 +22,7 @@ module MOM_restart implicit none ; private public restart_init, restart_end, restore_state, register_restart_field -public save_restart, query_initialized, set_initialized +public save_restart, query_initialized, set_initialized, only_read_from_restarts public restart_registry_lock, restart_init_end, vardesc public restart_files_exist, determine_is_new_run, is_new_run public register_restart_field_as_obsolete, register_restart_pair @@ -144,6 +144,16 @@ module MOM_restart module procedure set_initialized_3d_name, set_initialized_4d_name end interface +!> Read optional variables from restart files. +interface only_read_from_restarts + module procedure only_read_restart_field_4d + module procedure only_read_restart_field_3d + module procedure only_read_restart_field_2d +! module procedure only_read_restart_field_1d +! module procedure only_read_restart_field_0d + module procedure only_read_restart_pair_3d +end interface + contains !> Register a restart field as obsolete @@ -1042,6 +1052,193 @@ subroutine set_initialized_4d_name(f_ptr, name, CS) end subroutine set_initialized_4d_name +!====================== only_read_from_restarts variants ======================= + +!> Try to read a named 4-d field from the restart files +subroutine only_read_restart_field_4d(varname, f_ptr, G, CS, position, filename, directory, success, scale) + character(len=*), intent(in) :: varname !< The variable name to be used in the restart file + real, dimension(:,:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + integer, optional, intent(in) :: position !< A coded integer indicating the horizontal + !! position of this variable + character(len=*), optional, intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. + logical, optional, intent(out) :: success !< True if the field was read successfully + real, optional, intent(in) :: scale !< A factor by which the field will be scaled + + ! Local variables + character(len=:), allocatable :: file_path ! The full path to the file with the variable + logical :: found ! True if the variable was found. + logical :: is_global ! True if the variable is in a global file. + + found = find_var_in_restart_files(varname, G, CS, file_path, filename, directory, is_global) + + if (found) then + call MOM_read_data(file_path, varname, f_ptr, G%domain, timelevel=1, position=position, & + scale=scale, global_file=is_global) + endif + if (present(success)) success = found + +end subroutine only_read_restart_field_4d + +!> Try to read a named 3-d field from the restart files +subroutine only_read_restart_field_3d(varname, f_ptr, G, CS, position, filename, directory, success, scale) + character(len=*), intent(in) :: varname !< The variable name to be used in the restart file + real, dimension(:,:,:), intent(inout) :: f_ptr !< The array for the field to be read + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + integer, optional, intent(in) :: position !< A coded integer indicating the horizontal + !! position of this variable + character(len=*), optional, intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. + logical, optional, intent(out) :: success !< True if the field was read successfully + real, optional, intent(in) :: scale !< A factor by which the field will be scaled + + ! Local variables + character(len=:), allocatable :: file_path ! The full path to the file with the variable + logical :: found ! True if the variable was found. + logical :: is_global ! True if the variable is in a global file. + + found = find_var_in_restart_files(varname, G, CS, file_path, filename, directory, is_global) + + if (found) then + call MOM_read_data(file_path, varname, f_ptr, G%domain, timelevel=1, position=position, & + scale=scale, global_file=is_global) + endif + if (present(success)) success = found + +end subroutine only_read_restart_field_3d + +!> Try to read a named 2-d field from the restart files +subroutine only_read_restart_field_2d(varname, f_ptr, G, CS, position, filename, directory, success, scale) + character(len=*), intent(in) :: varname !< The variable name to be used in the restart file + real, dimension(:,:), intent(inout) :: f_ptr !< The array for the field to be read + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + integer, optional, intent(in) :: position !< A coded integer indicating the horizontal + !! position of this variable + character(len=*), optional, intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. + logical, optional, intent(out) :: success !< True if the field was read successfully + real, optional, intent(in) :: scale !< A factor by which the field will be scaled + + ! Local variables + character(len=:), allocatable :: file_path ! The full path to the file with the variable + logical :: found ! True if the variable was found. + logical :: is_global ! True if the variable is in a global file. + + found = find_var_in_restart_files(varname, G, CS, file_path, filename, directory, is_global) + + if (found) then + call MOM_read_data(file_path, varname, f_ptr, G%domain, timelevel=1, position=position, & + scale=scale, global_file=is_global) + endif + if (present(success)) success = found + +end subroutine only_read_restart_field_2d + + +!> Try to read a named 3-d field from the restart files +subroutine only_read_restart_pair_3d(a_ptr, b_ptr, a_name, b_name, G, CS, & + stagger, filename, directory, success, scale) + real, dimension(:,:,:), intent(inout) :: a_ptr !< The array for the first field to be read + real, dimension(:,:,:), intent(inout) :: b_ptr !< The array for the second field to be read + character(len=*), intent(in) :: a_name !< The first variable name to be used in the restart file + character(len=*), intent(in) :: b_name !< The second variable name to be used in the restart file + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + integer, optional, intent(in) :: stagger !< A coded integer indicating the horizontal + !! position of this pair of variables + character(len=*), optional, intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. + logical, optional, intent(out) :: success !< True if the field was read successfully + real, optional, intent(in) :: scale !< A factor by which the field will be scaled + + ! Local variables + character(len=:), allocatable :: file_path_a ! The full path to the file with the first variable + character(len=:), allocatable :: file_path_b ! The full path to the file with the second variable + integer :: a_pos, b_pos ! A coded position for the two variables. + logical :: a_found, b_found ! True if the variables were found. + logical :: global_a, global_b ! True if the variables are in global files. + + a_found = find_var_in_restart_files(a_name, G, CS, file_path_a, filename, directory, global_a) + b_found = find_var_in_restart_files(b_name, G, CS, file_path_b, filename, directory, global_b) + + a_pos = EAST_FACE ; b_pos = NORTH_FACE + if (present(stagger)) then ; select case (stagger) + case (AGRID) ; a_pos = CENTER ; b_pos = CENTER + case (BGRID_NE) ; a_pos = CORNER ; b_pos = CORNER + case (CGRID_NE) ; a_pos = EAST_FACE ; b_pos = NORTH_FACE + case default ; a_pos = EAST_FACE ; b_pos = NORTH_FACE + end select ; endif + + if (a_found .and. b_found) then + call MOM_read_data(file_path_a, a_name, a_ptr, G%domain, timelevel=1, position=a_pos, & + scale=scale, global_file=global_b, file_may_be_4d=.true.) + call MOM_read_data(file_path_b, b_name, b_ptr, G%domain, timelevel=1, position=b_pos, & + scale=scale, global_file=global_b, file_may_be_4d=.true.) + endif + if (present(success)) success = (a_found .and. b_found) + +end subroutine only_read_restart_pair_3d + +!> Return an indicationof whether the named variable is the restart files, and provie the full path +!! to the restart file in which a variable is found. +function find_var_in_restart_files(varname, G, CS, file_path, filename, directory, is_global) result (found) + character(len=*), intent(in) :: varname !< The variable name to be used in the restart file + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(MOM_restart_CS), intent(in) :: CS !< MOM restart control struct + character(len=:), allocatable, intent(out) :: file_path !< The full path to the file in which the + !! variable is found + character(len=*), optional, intent(in) :: filename !< The list of restart file names or a single + !! character 'r' to read automatically named files + character(len=*), optional, intent(in) :: directory !< The directory in which to seek restart files. + logical, optional, intent(out) :: is_global !< True if the file is global. + logical :: found !< True if the named variable was found in the restart files. + + ! Local variables + character(len=240), allocatable, dimension(:) :: file_paths ! The possible file names. + character(len=:), allocatable :: dir ! The directory to read from. + character(len=:), allocatable :: fname ! The list of file names. + logical, allocatable, dimension(:) :: global_file ! True if the file is global + integer :: n, num_files + + dir = "./INPUT/" ; if (present(directory)) dir = trim(directory) + + ! Set the default return values. + found = .false. + file_path = "" + if (present(is_global)) is_global = .false. + + fname = 'r' + if (present(filename)) then + if (.not.((LEN_TRIM(filename) == 1) .and. (filename(1:1) == 'F'))) fname = filename + endif + + num_files = get_num_restart_files(fname, dir, G, CS) + if (num_files == 0) return + allocate(file_paths(num_files), global_file(num_files)) + num_files = open_restart_units(fname, dir, G, CS, file_paths=file_paths, global_files=global_file) + + do n=1,num_files ; if (field_exists(file_paths(n), varname, MOM_Domain=G%domain)) then + found = .true. + file_path = file_paths(n) + if (present(is_global)) is_global = global_file(n) + exit + endif ; enddo + + deallocate(file_paths, global_file) + +end function find_var_in_restart_files + +!====================== end of the only_read_from_restarts variants ======================= + + !> save_restart saves all registered variables to restart files. subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_rest_files, write_IC) character(len=*), intent(in) :: directory !< The directory where the restart files diff --git a/src/framework/posix.F90 b/src/framework/posix.F90 index 522024071e..142d7634e2 100644 --- a/src/framework/posix.F90 +++ b/src/framework/posix.F90 @@ -344,4 +344,22 @@ subroutine siglongjmp(env, val) call siglongjmp_posix(env, val_c) end subroutine siglongjmp +!> Placeholder function for a missing or unconfigured sigsetjmp +!! +!! The symbol for sigsetjmp can be platform-dependent and may not exist if +!! defined as a macro. This function allows compilation, and reports a runtime +!! error if used in the program. +function sigsetjmp_missing(env, savesigs) result(rc) bind(c) + type(sigjmp_buf), intent(in) :: env + !< Current process state (unused) + integer(kind=c_int), value, intent(in) :: savesigs + !< Enable signal state flag (unused) + integer(kind=c_int) :: rc + !< Function return code (unused) + + print '(a)', 'ERROR: sigsetjmp() is not implemented in this build.' + print '(a)', 'Recompile with autoconf or -DSIGSETJMP_NAME=\"\".' + error stop +end function sigsetjmp_missing + end module posix diff --git a/src/framework/posix.h b/src/framework/posix.h index d60a868a91..96dec57814 100644 --- a/src/framework/posix.h +++ b/src/framework/posix.h @@ -14,7 +14,7 @@ ! glibc defines sigsetjmp as __sigsetjmp via macro readable from . #ifndef SIGSETJMP_NAME -#define SIGSETJMP_NAME "__sigsetjmp" +#define SIGSETJMP_NAME "sigsetjmp_missing" #endif ! This should be defined by /usr/include/signal.h diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index f0fb1d23f9..88c6377abc 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -23,6 +23,7 @@ module MOM_fixed_initialization use MOM_shared_initialization, only : set_rotation_planetary, set_rotation_beta_plane, initialize_grid_rotation_angle use MOM_shared_initialization, only : reset_face_lengths_named, reset_face_lengths_file, reset_face_lengths_list use MOM_shared_initialization, only : read_face_length_list, set_velocity_depth_max, set_velocity_depth_min +use MOM_shared_initialization, only : set_subgrid_topo_at_vel_from_file use MOM_shared_initialization, only : compute_global_grid_integrals, write_ocean_geometry_file use MOM_unit_scaling, only : unit_scale_type @@ -62,6 +63,7 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) ! Local character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config + logical :: read_porous_file character(len=40) :: mdl = "MOM_fixed_initialization" ! This module's name. logical :: debug ! This include declares and sets the variable "version". @@ -142,6 +144,13 @@ subroutine MOM_initialize_fixed(G, US, OBC, PF, write_geom, output_dir) end select endif + ! Read sub-grid scale topography parameters at velocity points used for porous barrier calculation + call get_param(PF, mdl, "SUBGRID_TOPO_AT_VEL", read_porous_file, & + "If true, use variables from TOPO_AT_VEL_FILE as parameters for porous barrier.", & + default=.False.) + if (read_porous_file) & + call set_subgrid_topo_at_vel_from_file(G, PF, US) + ! Calculate the value of the Coriolis parameter at the latitude ! ! of the q grid points [T-1 ~> s-1]. call MOM_initialize_rotation(G%CoriolisBu, G, PF, US=US) diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index bc004daa95..d84d2275e4 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -1206,6 +1206,8 @@ subroutine initialize_masks(G, PF, US) else G%mask2dCu(I,j) = 1.0 endif + ! This mask may be revised later after the open boundary positions are specified. + G%OBCmaskCu(I,j) = G%mask2dCu(I,j) enddo ; enddo do J=G%jsd,G%jed-1 ; do i=G%isd,G%ied @@ -1214,6 +1216,8 @@ subroutine initialize_masks(G, PF, US) else G%mask2dCv(i,J) = 1.0 endif + ! This mask may be revised later after the open boundary positions are specified. + G%OBCmaskCv(i,J) = G%mask2dCv(i,J) enddo ; enddo do J=G%jsd,G%jed-1 ; do I=G%isd,G%ied-1 @@ -1229,12 +1233,14 @@ subroutine initialize_masks(G, PF, US) call pass_vector(G%mask2dCu, G%mask2dCv, G%Domain, To_All+Scalar_Pair, CGRID_NE) do j=G%jsd,G%jed ; do I=G%IsdB,G%IedB + ! This open face length may be revised later. G%dy_Cu(I,j) = G%mask2dCu(I,j) * G%dyCu(I,j) G%areaCu(I,j) = G%dxCu(I,j) * G%dy_Cu(I,j) G%IareaCu(I,j) = G%mask2dCu(I,j) * Adcroft_reciprocal(G%areaCu(I,j)) enddo ; enddo do J=G%JsdB,G%JedB ; do i=G%isd,G%ied + ! This open face length may be revised later. G%dx_Cv(i,J) = G%mask2dCv(i,J) * G%dxCv(i,J) G%areaCv(i,J) = G%dyCv(i,J) * G%dx_Cv(i,J) G%IareaCv(i,J) = G%mask2dCv(i,J) * Adcroft_reciprocal(G%areaCv(i,J)) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 52f47f9581..ff272e7fce 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -27,6 +27,7 @@ module MOM_shared_initialization public set_rotation_planetary, set_rotation_beta_plane, initialize_grid_rotation_angle public reset_face_lengths_named, reset_face_lengths_file, reset_face_lengths_list public read_face_length_list, set_velocity_depth_max, set_velocity_depth_min +public set_subgrid_topo_at_vel_from_file public compute_global_grid_integrals, write_ocean_geometry_file ! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional @@ -1165,6 +1166,82 @@ subroutine read_face_length_list(iounit, filename, num_lines, lines) end subroutine read_face_length_list ! ----------------------------------------------------------------------------- +! ----------------------------------------------------------------------------- +!> Read from a file the maximum, minimum and average bathymetry at velocity points, +!! for the use of porous barrier. +!! Note that we assume the depth values in the sub-grid bathymetry file of the same +!! convention as in-cell bathymetry file, i.e. positive below the sea surface and +!! increasing downward; while in subroutine reset_face_lengths_list, it is implied +!! that read-in fields min_bathy, max_bathy and avg_bathy from the input file +!! CHANNEL_LIST_FILE all have negative values below the surface. Therefore, to ensure +!! backward compatibility, all signs of the variable are inverted here. +!! And porous_Dmax[UV] = shallowest point, porous_Dmin[UV] = deepest point +subroutine set_subgrid_topo_at_vel_from_file(G, param_file, US) + type(dyn_horgrid_type), intent(inout) :: G !< The dynamic horizontal grid type + type(param_file_type), intent(in) :: param_file !< Parameter file structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + + ! Local variables + character(len=200) :: filename, topo_file, inputdir ! Strings for file/path + character(len=200) :: varname_uhi, varname_ulo, varname_uav, & + varname_vhi, varname_vlo, varname_vav ! Variable names in file + character(len=40) :: mdl = "set_subgrid_topo_at_vel_from_file" ! This subroutine's name. + integer :: i, j + + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + inputdir = slasher(inputdir) + call get_param(param_file, mdl, "TOPO_AT_VEL_FILE", topo_file, & + "The file from which the bathymetry parameters at the velocity points are read. "//& + "While the names of the parameters reflect their physical locations, i.e. HIGH is above LOW, "//& + "their signs follow the model's convention, which is positive below the sea surface", & + default="topog_edge.nc") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_U_HIGH", varname_uhi, & + "The variable name of the highest bathymetry at the u-cells in TOPO_AT_VEL_FILE.", & + default="depthu_hi") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_U_LOW", varname_ulo, & + "The variable name of the lowest bathymetry at the u-cells in TOPO_AT_VEL_FILE.", & + default="depthu_lo") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_U_AVE", varname_uav, & + "The variable name of the average bathymetry at the u-cells in TOPO_AT_VEL_FILE.", & + default="depthu_av") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_V_HIGH", varname_vhi, & + "The variable name of the highest bathymetry at the v-cells in TOPO_AT_VEL_FILE.", & + default="depthv_hi") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_V_LOW", varname_vlo, & + "The variable name of the lowest bathymetry at the v-cells in TOPO_AT_VEL_FILE.", & + default="depthv_lo") + call get_param(param_file, mdl, "TOPO_AT_VEL_VARNAME_V_AVE", varname_vav, & + "The variable name of the average bathymetry at the v-cells in TOPO_AT_VEL_FILE.", & + default="depthv_av") + + filename = trim(inputdir)//trim(topo_file) + call log_param(param_file, mdl, "INPUTDIR/TOPO_AT_VEL_FILE", filename) + + if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + " set_subgrid_topo_at_vel_from_file: Unable to open "//trim(filename)) + + call MOM_read_vector(filename, trim(varname_uhi), trim(varname_vhi), & + G%porous_DmaxU, G%porous_DmaxV, G%Domain, stagger=CGRID_NE, scale=US%m_to_Z) + call MOM_read_vector(filename, trim(varname_ulo), trim(varname_vlo), & + G%porous_DminU, G%porous_DminV, G%Domain, stagger=CGRID_NE, scale=US%m_to_Z) + call MOM_read_vector(filename, trim(varname_uav), trim(varname_vav), & + G%porous_DavgU, G%porous_DavgV, G%Domain, stagger=CGRID_NE, scale=US%m_to_Z) + + ! The signs of the depth parameters need to be inverted to be backward compatible with input files + ! used by subroutine reset_face_lengths_list, which assumes depth is negative below the sea surface. + G%porous_DmaxU = -G%porous_DmaxU; G%porous_DminU = -G%porous_DminU; G%porous_DavgU = -G%porous_DavgU + G%porous_DmaxV = -G%porous_DmaxV; G%porous_DminV = -G%porous_DminV; G%porous_DavgV = -G%porous_DavgV + + call pass_vector(G%porous_DmaxU, G%porous_DmaxV, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(G%porous_DminU, G%porous_DminV, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + call pass_vector(G%porous_DavgU, G%porous_DavgV, G%Domain, To_All+SCALAR_PAIR, CGRID_NE) + + call callTree_leave(trim(mdl)//'()') +end subroutine set_subgrid_topo_at_vel_from_file +! ----------------------------------------------------------------------------- + ! ----------------------------------------------------------------------------- !> Set the bathymetry at velocity points to be the maximum of the depths at the !! neighoring tracer points. diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index b8e74e3c45..31dbb41dcc 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -2135,9 +2135,11 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t if (use_temperature) then allocate(tmp_tr(isd:ied,jsd:jed,nz_data)) call MOM_read_data(filename, potemp_var, tmp_tr(:,:,:), G%Domain, scale=US%degC_to_C) - call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%T, ALE_CSp) + call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%T, ALE_CSp, 'temp', & + sp_long_name='temperature', sp_unit='degC s-1') call MOM_read_data(filename, salin_var, tmp_tr(:,:,:), G%Domain, scale=US%ppt_to_S) - call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%S, ALE_CSp) + call set_up_ALE_sponge_field(tmp_tr, G, GV, tv%S, ALE_CSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') deallocate(tmp_tr) endif if (sponge_uv) then @@ -2160,8 +2162,10 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t endif ! The remaining calls to set_up_sponge_field can be in any order. if ( use_temperature) then - call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp, scale=US%degC_to_C) - call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp, scale=US%ppt_to_S) + call set_up_ALE_sponge_field(filename, potemp_var, Time, G, GV, US, tv%T, ALE_CSp, & + 'temp', sp_long_name='temperature', sp_unit='degC s-1', scale=US%degC_to_C) + call set_up_ALE_sponge_field(filename, salin_var, Time, G, GV, US, tv%S, ALE_CSp, & + 'salt', sp_long_name='salinity', sp_unit='g kg-1 s-1', scale=US%ppt_to_S) endif if (sponge_uv) then filename = trim(inputdir)//trim(state_uv_file) @@ -2647,7 +2651,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just "If true use an expression with a vertical indexing bug for extrapolating the "//& "densities at the bottom of unstable profiles from data when finding the "//& "initial interface locations in layered mode from a dataset of T and S.", & - default=.true., do_not_log=just_read) + default=.false., do_not_log=just_read) ! Reusing MINIMUM_DEPTH for the default mixed layer depth may be a strange choice, but ! it reproduces previous answers. endif @@ -2775,7 +2779,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just call regridding_preadjust_reqs(regridCS, do_conv_adj, ignore) if (do_conv_adj) call convective_adjustment(G, GV_loc, h1, tv_loc) - call regridding_main( remapCS, regridCS, G, GV_loc, h1, tv_loc, h, dz_interface, conv_adjust=.false., & + call regridding_main( remapCS, regridCS, G, GV_loc, h1, tv_loc, h, dz_interface, & frac_shelf_h=frac_shelf_h ) deallocate( dz_interface ) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 9b024e62b0..ead6086346 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -462,7 +462,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do j=js-1,je+1 ; do I=is-2,ie+1 ! MEKE_uflux is used here as workspace with units of [L2 T-2 ~> m2 s-2]. - MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%mask2dCu(I,j)) * & + MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * G%OBCmaskCu(I,j)) * & (MEKE%MEKE(i+1,j) - MEKE%MEKE(i,j)) ! This would have units of [R Z L2 T-2 ~> kg s-2] ! MEKE_uflux(I,j) = ((G%dy_Cu(I,j)*G%IdxCu(I,j)) * & @@ -472,7 +472,7 @@ subroutine step_forward_MEKE(MEKE, h, SN_u, SN_v, visc, dt, G, GV, US, CS, hu, h !$OMP parallel do default(shared) do J=js-2,je+1 ; do i=is-1,ie+1 ! MEKE_vflux is used here as workspace with units of [L2 T-2 ~> m2 s-2]. - MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%mask2dCv(i,J)) * & + MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * G%OBCmaskCv(i,J)) * & (MEKE%MEKE(i,j+1) - MEKE%MEKE(i,j)) ! This would have units of [R Z L2 T-2 ~> kg s-2] ! MEKE_vflux(i,J) = ((G%dx_Cv(i,J)*G%IdyCv(i,J)) * & diff --git a/src/parameterizations/lateral/MOM_interface_filter.F90 b/src/parameterizations/lateral/MOM_interface_filter.F90 new file mode 100644 index 0000000000..dd082f1558 --- /dev/null +++ b/src/parameterizations/lateral/MOM_interface_filter.F90 @@ -0,0 +1,471 @@ +!> Interface height filtering module +module MOM_interface_filter + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_debugging, only : hchksum, uvchksum +use MOM_diag_mediator, only : post_data, query_averaging_enabled, diag_ctrl +use MOM_diag_mediator, only : register_diag_field, safe_alloc_ptr, time_type +use MOM_domains, only : pass_var, CORNER, pass_vector +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_grid, only : ocean_grid_type +use MOM_interface_heights, only : find_eta +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs, cont_diag_ptrs +use MOM_verticalGrid, only : verticalGrid_type + +implicit none ; private + +#include + +public interface_filter, interface_filter_init, interface_filter_end + +! A note on unit descriptions in comments: MOM6 uses units that can be rescaled for dimensional +! consistency testing. These are noted in comments with units like Z, H, L, and T, along with +! their mks counterparts with notation like "a velocity [Z T-1 ~> m s-1]". If the units +! vary with the Boussinesq approximation, the Boussinesq variant is given first. + +!> Control structure for interface height filtering +type, public :: interface_filter_CS ; private + logical :: initialized = .false. !< True if this control structure has been initialized. + real :: max_smoothing_CFL !< Maximum value of the smoothing CFL for interface height filtering [nondim] + real :: filter_rate !< The rate at which grid-scale anomalies are damped away [T-1 ~> s-1] + integer :: filter_order !< The even power of the interface height smoothing. + !! At present valid values are 0, 2, or 4. + logical :: interface_filter !< If true, interfaces heights are diffused. + logical :: isotropic_filter !< If true, use the same filtering lengthscales in both directions, + !! otherwise use filtering lengthscales in each direction that scale + !! with the grid spacing in that direction. + logical :: debug !< write verbose checksums for debugging purposes + + type(diag_ctrl), pointer :: diag => NULL() !< structure used to regulate timing of diagnostics + + !>@{ + !! Diagnostic identifier + integer :: id_uh_sm = -1, id_vh_sm = -1 + integer :: id_L2_u = -1, id_L2_v = -1 + integer :: id_sfn_x = -1, id_sfn_y = -1 + !>@} +end type interface_filter_CS + +contains + +!> Apply a transport that leads to a smoothing of interface height, subject to limits that +!! ensure stability and positive definiteness of layer thicknesses. +!! It also updates the along-layer mass fluxes used in the tracer transport equations. +subroutine interface_filter(h, uhtr, vhtr, tv, dt, G, GV, US, CDp, CS) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Accumulated zonal mass flux + !! [L2 H ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Accumulated meridional mass flux + !! [L2 H ~> m3 or kg] + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamics structure + real, intent(in) :: dt !< Time increment [T ~> s] + type(cont_diag_ptrs), intent(inout) :: CDp !< Diagnostics for the continuity equation + type(interface_filter_CS), intent(inout) :: CS !< Control structure for interface height + !! filtering + ! Local variables + real :: e(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Heights of interfaces, relative to mean + ! sea level [Z ~> m], positive up. + real :: de_smooth(SZI_(G),SZJ_(G),SZK_(GV)+1) ! Change in the heights of interfaces after one pass + ! of Laplacian smoothing [Z ~> m], positive downward to avoid + ! having to change other signs in the call to interface_filter. + real :: uhD(SZIB_(G),SZJ_(G),SZK_(GV)) ! Smoothing u*h fluxes within a timestep [L2 H ~> m3 or kg] + real :: vhD(SZI_(G),SZJB_(G),SZK_(GV)) ! Smoothing v*h fluxes within a timestep [L2 H ~> m3 or kg] + + real, dimension(SZIB_(G),SZJ_(G)) :: & + Lsm2_u ! Interface height squared smoothing lengths per timestep at u-points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)) :: & + Lsm2_v ! Interface height squared smoothing lengths per timestep at v-points [L2 ~> m2] + + real :: diag_sfn_x(SZIB_(G),SZJ_(G),SZK_(GV)+1) ! Diagnostic of the x-face streamfunction + ! [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: diag_sfn_y(SZI_(G),SZJB_(G),SZK_(GV)+1) ! Diagnostic of the y-face streamfunction + ! [H L2 T-1 ~> m3 s-1 or kg s-1] + real :: filter_strength ! The amount of filtering within a each iteration [nondim] + real :: Idt ! The inverse of the timestep [T-1 ~> s-1] + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + integer :: itt, filter_itts ! The number of iterations of the filter, set as 1/2 the power. + integer :: i, j, k, is, ie, js, je, nz, hs + + if (.not. CS%initialized) call MOM_error(FATAL, "MOM_interface_filter: "//& + "Module must be initialized before it is used.") + + if ((.not.CS%interface_filter) .or. (CS%filter_rate <= 0.0) .or. (CS%filter_order < 2)) return + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + h_neglect = GV%H_subroundoff + + filter_itts = CS%filter_order / 2 + Idt = 1.0 / dt + + if (filter_itts > min(G%isc-G%isd, G%jsc-G%jsd)) call MOM_error(FATAL, & + "interface_filter: The halos are not wide enough to accommodate the filter "//& + "order specified by INTERFACE_FILTER_ORDER.") + + ! Calculates interface heights, e, in [Z ~> m]. + call find_eta(h, tv, G, GV, US, e, halo_size=filter_itts) + + ! Set the smoothing length scales to apply at each iteration. + if (filter_itts == 1) then + filter_strength = min(CS%filter_rate*dt, CS%max_smoothing_CFL) + elseif (filter_itts == 2) then + filter_strength = min(sqrt(CS%filter_rate*dt), CS%max_smoothing_CFL) + else + filter_strength = min((CS%filter_rate*dt)**(1.0/filter_itts), CS%max_smoothing_CFL) + endif + hs = filter_itts-1 + if (CS%isotropic_filter) then + !$OMP parallel do default(shared) + do j=js-hs,je+hs ; do I=is-(hs+1),ie+hs + Lsm2_u(I,j) = (0.25*filter_strength) / (G%IdxCu(I,j)**2 + G%IdyCu(I,j)**2) + enddo ; enddo + !$OMP parallel do default(shared) + do J=js-(hs+1),je+hs ; do i=is-hs,ie+hs + Lsm2_v(i,J) = (0.25*filter_strength) / (G%IdxCv(i,J)**2 + G%IdyCv(i,J)**2) + enddo ; enddo + else + !$OMP parallel do default(shared) + do j=js-hs,je+hs ; do I=is-(hs+1),ie+hs + Lsm2_u(I,j) = (0.125*filter_strength) * (min(G%areaT(i,j), G%areaT(i+1,j)) * G%IdyCu(I,j))**2 + enddo ; enddo + !$OMP parallel do default(shared) + do J=js-(hs+1),je+hs ; do i=is-hs,ie+hs + Lsm2_v(i,J) = (0.125*filter_strength) * (min(G%areaT(i,j), G%areaT(i,j+1)) * G%IdxCv(i,J))**2 + enddo ; enddo + endif + + if (CS%debug) then + call uvchksum("Kh_[uv]", Lsm2_u, Lsm2_v, G%HI, haloshift=hs, & + scale=US%L_to_m**2, scalar_pair=.true.) + call hchksum(h, "interface_filter_1 h", G%HI, haloshift=hs+1, scale=GV%H_to_m) + call hchksum(e, "interface_filter_1 e", G%HI, haloshift=hs+1, scale=US%Z_to_m) + endif + + ! Calculate uhD, vhD from h, e, Lsm2_u, Lsm2_v + call filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size=filter_itts-1) + + + do itt=2,filter_itts + hs = (filter_itts - itt) + 1 ! Set the halo size to work on. + !$OMP parallel do default(shared) + do j=js-hs,je+hs + do i=is-hs,ie+hs ; de_smooth(i,j,nz+1) = 0.0 ; enddo + do k=nz,1,-1 ; do i=is-hs,ie+hs + de_smooth(i,j,k) = de_smooth(i,j,k+1) + GV%H_to_Z * G%IareaT(i,j) * & + ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) + enddo ; enddo + enddo + + ! Calculate uhD, vhD from h, de_smooth, Lsm2_u, Lsm2_v + call filter_interface(h, de_smooth, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size=filter_itts-itt) + enddo + + ! Offer diagnostic fields for averaging. This must occur before updating the layer thicknesses + ! so that the diagnostics can be remapped properly to other diagnostic vertical coordinates. + if (query_averaging_enabled(CS%diag)) then + if (CS%id_sfn_x > 0) then + diag_sfn_x(:,:,1) = 0.0 ; diag_sfn_x(:,:,nz+1) = 0.0 + do K=nz,2,-1 ; do j=js,je ; do I=is-1,ie + if (CS%id_sfn_x>0) diag_sfn_x(I,j,K) = diag_sfn_x(I,j,K+1) + uhD(I,j,k) + enddo ; enddo ; enddo + call post_data(CS%id_sfn_x, diag_sfn_x, CS%diag) + endif + if (CS%id_sfn_y > 0) then + diag_sfn_y(:,:,1) = 0.0 ; diag_sfn_y(:,:,nz+1) = 0.0 + do K=nz,2,-1 ; do J=js-1,je ; do i=is,ie + diag_sfn_y(i,J,K) = diag_sfn_y(i,J,K+1) + vhD(i,J,k) + enddo ; enddo ; enddo + call post_data(CS%id_sfn_y, diag_sfn_y, CS%diag) + endif + if (CS%id_uh_sm > 0) call post_data(CS%id_uh_sm, Idt*uhD(:,:,:), CS%diag) + if (CS%id_vh_sm > 0) call post_data(CS%id_vh_sm, Idt*vhD(:,:,:), CS%diag) + if (CS%id_L2_u > 0) call post_data(CS%id_L2_u, Lsm2_u, CS%diag) + if (CS%id_L2_v > 0) call post_data(CS%id_L2_v, Lsm2_v, CS%diag) + endif + + ! Update the layer thicknesses, and store the transports that will be needed for the tracers. + !$OMP parallel do default(shared) + do k=1,nz + do j=js,je ; do I=is-1,ie + uhtr(I,j,k) = uhtr(I,j,k) + uhD(I,j,k) + enddo ; enddo + do J=js-1,je ; do i=is,ie + vhtr(i,J,k) = vhtr(i,J,k) + vhD(i,J,k) + enddo ; enddo + do j=js,je ; do i=is,ie + h(i,j,k) = h(i,j,k) - G%IareaT(i,j) * & + ((uhD(I,j,k) - uhD(I-1,j,k)) + (vhD(i,J,k) - vhD(i,J-1,k))) + if (h(i,j,k) < GV%Angstrom_H) h(i,j,k) = GV%Angstrom_H + enddo ; enddo + + ! Store the transports associated with the smoothing if they are needed for diagnostics. + if (associated(CDp%uh_smooth)) then ; do j=js,je ; do I=is-1,ie + CDp%uh_smooth(I,j,k) = uhD(I,j,k)*Idt + enddo ; enddo ; endif + if (associated(CDp%vh_smooth)) then ; do J=js-1,je ; do i=is,ie + CDp%vh_smooth(i,J,k) = vhD(i,J,k)*Idt + enddo ; enddo ; endif + + enddo + + if (CS%debug) then + call uvchksum("interface_filter [uv]hD", uhD, vhD, & + G%HI, haloshift=0, scale=GV%H_to_m*US%L_to_m**2) + call uvchksum("interface_filter [uv]htr", uhtr, vhtr, & + G%HI, haloshift=0, scale=US%L_to_m**2*GV%H_to_m) + call hchksum(h, "interface_filter h", G%HI, haloshift=0, scale=GV%H_to_m) + endif + +end subroutine interface_filter + +!> Calculates parameterized layer transports for use in the continuity equation. +!! Fluxes are limited to give positive definite thicknesses. +!! Called by interface_filter(). +subroutine filter_interface(h, e, Lsm2_u, Lsm2_v, uhD, vhD, G, GV, US, halo_size) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface positions [Z ~> m] + real, dimension(SZIB_(G),SZJ_(G)), intent(in) :: Lsm2_u !< Interface smoothing lengths squared + !! at u points [L2 ~> m2] + real, dimension(SZI_(G),SZJB_(G)), intent(in) :: Lsm2_v !< Interface smoothing lengths squared + !! at v points [L2 ~> m2] + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: uhD !< Zonal mass fluxes + !! [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: vhD !< Meridional mass fluxes + !! [H L2 ~> m3 or kg] + integer, optional, intent(in) :: halo_size !< The size of the halo to work on, + !! 0 by default. + + ! Local variables + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & + h_avail ! The mass available for diffusion out of each face [H L2 ~> m3 or kg]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1) :: & + h_avail_rsum ! The running sum of h_avail above an interface [H L2 ~> m3 or kg]. + real :: uhtot(SZIB_(G),SZJ_(G)) ! The vertical sum of uhD [H L2 ~> m3 or kg]. + real :: vhtot(SZI_(G),SZJB_(G)) ! The vertical sum of vhD [H L2 ~> m3 or kg]. + real :: Slope ! The slope of density surfaces, calculated in a way that is always + ! between -1 and 1 after undoing dimensional scaling, [Z L-1 ~> nondim] + real :: Sfn_est ! A preliminary estimate (before limiting) of the overturning + ! streamfunction [H L2 ~> m3 or kg]. + real :: Sfn ! The overturning streamfunction [H L2 ~> m3 or kg]. + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. + integer :: i, j, k, is, ie, js, je, nz, hs + + hs = 0 ; if (present(halo_size)) hs = halo_size + is = G%isc-hs ; ie = G%iec+hs ; js = G%jsc-hs ; je = G%jec+hs ; nz = GV%ke + + h_neglect = GV%H_subroundoff + + ! Find the maximum and minimum permitted streamfunction. + !$OMP parallel do default(shared) + do j=js-1,je+1 + do i=is-1,ie+1 + h_avail_rsum(i,j,1) = 0.0 + h_avail(i,j,1) = max(0.25*G%areaT(i,j)*(h(i,j,1)-GV%Angstrom_H),0.0) + h_avail_rsum(i,j,2) = h_avail(i,j,1) + enddo + do k=2,nz ; do i=is-1,ie+1 + h_avail(i,j,k) = max(0.25*G%areaT(i,j)*(h(i,j,k)-GV%Angstrom_H),0.0) + h_avail_rsum(i,j,k+1) = h_avail_rsum(i,j,k) + h_avail(i,j,k) + enddo ; enddo + enddo + + !$OMP parallel do default(shared) private(Slope,Sfn_est,Sfn) + do j=js,je + do I=is-1,ie ; uhtot(I,j) = 0.0 ; enddo + do K=nz,2,-1 + do I=is-1,ie + Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%OBCmaskCu(I,j) + + Sfn_est = (Lsm2_u(I,j)*G%dy_Cu(I,j)) * (GV%Z_to_H * Slope) + + ! Make sure that there is enough mass above to allow the streamfunction + ! to satisfy the boundary condition of 0 at the surface. + Sfn = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i+1,j,K)) + + ! The actual transport is limited by the mass available in the two + ! neighboring grid cells. + uhD(I,j,k) = max(min((Sfn - uhtot(I,j)), h_avail(i,j,k)), & + -h_avail(i+1,j,k)) + + ! sfn_x(I,j,K) = max(min(Sfn, uhtot(I,j)+h_avail(i,j,k)), & + ! uhtot(I,j)-h_avail(i+1,j,K)) + + uhtot(I,j) = uhtot(I,j) + uhD(I,j,k) + + enddo + enddo ! end of k-loop + + ! In layer 1, enforce the boundary conditions that Sfn(z=0) = 0.0 + do I=is-1,ie ; uhD(I,j,1) = -uhtot(I,j) ; enddo + enddo ! end of j-loop + + ! Calculate the meridional fluxes and gradients. + + !$OMP parallel do default(shared) private(Slope,Sfn_est,Sfn) + do J=js-1,je + do i=is,ie ; vhtot(i,J) = 0.0 ; enddo + do K=nz,2,-1 + do i=is,ie + Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%OBCmaskCv(i,J) + + Sfn_est = (Lsm2_v(i,J)*G%dx_Cv(i,J)) * (GV%Z_to_H * Slope) + + ! Make sure that there is enough mass above to allow the streamfunction + ! to satisfy the boundary condition of 0 at the surface. + Sfn = min(max(Sfn_est, -h_avail_rsum(i,j,K)), h_avail_rsum(i,j+1,K)) + + ! The actual transport is limited by the mass available in the two neighboring grid cells. + vhD(i,J,k) = max(min((Sfn - vhtot(i,J)), h_avail(i,j,k)), -h_avail(i,j+1,k)) + + ! sfn_y(i,J,K) = max(min(Sfn, vhtot(i,J)+h_avail(i,j,k)), & + ! vhtot(i,J)-h_avail(i,j+1,k)) + + vhtot(i,J) = vhtot(i,J) + vhD(i,J,k) + + enddo + enddo ! end of k-loop + ! In layer 1, enforce the boundary conditions that Sfn(z=0) = 0.0 + do i=is,ie ; vhD(i,J,1) = -vhtot(i,J) ; enddo + enddo ! end of j-loop + +end subroutine filter_interface + +!> Initialize the interface height filtering module/structure +subroutine interface_filter_init(Time, G, GV, US, param_file, diag, CDp, CS) + type(time_type), intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< Parameter file handles + type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure + type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity equation diagnostics + type(interface_filter_CS), intent(inout) :: CS !< Control structure for interface height filtering + + ! Local variables + character(len=40) :: mdl = "MOM_interface_filter" ! This module's name. + ! This include declares and sets the variable "version". +# include "version_variable.h" + real :: grid_sp ! The local grid spacing [L ~> m] + real :: interface_filter_time ! The grid-scale interface height filtering timescale [T ~> s] + integer :: i, j + + CS%initialized = .true. + 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, "INTERFACE_FILTER_TIME", interface_filter_time, & + "If positive, interface heights are subjected to a grid-scale "//& + "dependent biharmonic filter, using a rate based on this timescale.", & + default=0.0, units="s", scale=US%s_to_T) + CS%filter_rate = 0.0 + if (interface_filter_time > 0.0) CS%filter_rate = 1.0 / interface_filter_time + CS%interface_filter = (interface_filter_time > 0.0) + call get_param(param_file, mdl, "INTERFACE_FILTER_MAX_CFL", CS%max_smoothing_CFL, & + "The maximum value of the local CFL ratio that "//& + "is permitted for the interface height smoothing. 1.0 is the "//& + "marginally unstable value.", units="nondimensional", default=0.8) + if (CS%max_smoothing_CFL < 0.0) CS%max_smoothing_CFL = 0.0 + + call get_param(param_file, mdl, "INTERFACE_FILTER_ORDER", CS%filter_order, & + "The even power of the interface height smoothing. "//& + "At present valid values are 0, 2, 4 or 6.", default=4) + if (CS%filter_order == 0) then + CS%filter_rate = 0.0 + elseif ((CS%filter_order /= 2) .and. (CS%filter_order /= 4) .and. (CS%filter_order /= 6)) then + call MOM_error(FATAL, "Unsupported value of INTERFACE_FILTER_ORDER specified. "//& + "Only 0, 2, 4 or 6 are supported.") + endif + call get_param(param_file, mdl, "INTERFACE_FILTER_ISOTROPIC", CS%isotropic_filter, & + "If true, use the same filtering lengthscales in both directions; "//& + "otherwise use filtering lengthscales in each direction that scale "//& + "with the grid spacing in that direction.", default=.true.) + + call get_param(param_file, mdl, "DEBUG", CS%debug, & + "If true, write out verbose debugging data.", & + default=.false., debuggingParam=.true.) + + if (CS%filter_order > 0) then + CS%id_uh_sm = register_diag_field('ocean_model', 'uh_smooth', diag%axesCuL, Time, & + 'Interface Smoothing Zonal Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + y_cell_method='sum', v_extensive=.true.) + CS%id_vh_sm = register_diag_field('ocean_model', 'vh_smooth', diag%axesCvL, Time, & + 'Interface Smoothing Meridional Thickness Flux', & + 'kg s-1', conversion=GV%H_to_kg_m2*US%L_to_m**2*US%s_to_T, & + x_cell_method='sum', v_extensive=.true.) + + CS%id_L2_u = register_diag_field('ocean_model', 'Lsmooth2_u', diag%axesCu1, Time, & + 'Interface height smoothing length-scale squared at U-points', & + 'm2', conversion=US%L_to_m**2) + CS%id_L2_v = register_diag_field('ocean_model', 'Lsmooth2_u', diag%axesCv1, Time, & + 'Interface height smoothing length-scale squared at V-points', & + 'm2', conversion=US%L_to_m**2) + + CS%id_sfn_x = register_diag_field('ocean_model', 'Smooth_sfn_x', diag%axesCui, Time, & + 'Interface smoothing Zonal Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) + CS%id_sfn_y = register_diag_field('ocean_model', 'Smooth_sfn_y', diag%axesCvi, Time, & + 'Interface smoothing Meridional Overturning Streamfunction', & + 'm3 s-1', conversion=GV%H_to_m*US%L_to_m**2*US%s_to_T) + endif + +end subroutine interface_filter_init + +!> Deallocate the interface height filtering control structure +subroutine interface_filter_end(CS, CDp) + type(interface_filter_CS), intent(inout) :: CS !< Control structure for interface height filtering + type(cont_diag_ptrs), intent(inout) :: CDp !< Continuity diagnostic control structure + + ! NOTE: [uv]h_smooth are not yet used in diagnostics, but they are here for now for completeness. + if (associated(CDp%uh_smooth)) deallocate(CDp%uh_smooth) + if (associated(CDp%vh_smooth)) deallocate(CDp%vh_smooth) + +end subroutine interface_filter_end + +!> \namespace mom_interface_filter +!! +!! \section section_interface_filter Interface height filtering +!! +!! Interface height filtering is implemented via along-layer mass fluxes +!! \f[ +!! h^\dagger \leftarrow h^n - \Delta t \nabla \cdot ( \vec{uh}^* ) +!! \f] +!! where the mass fluxes are cast as the difference in vector streamfunction +!! +!! \f[ +!! \vec{uh}^* = \delta_k \vec{\psi} . +!! \f] +!! +!! The streamfunction is proportional to the slope in the difference between +!! unsmoothed interface heights and those smoothed with one (or more) passes of a Laplacian +!! filter, depending on the order of the filter, or to the slope for a Laplacian +!! filter +!! \f[ +!! \vec{\psi} = - \kappa_h {\nabla \eta - \eta_smooth} +!! \f] +!! +!! The result of the above expression is subsequently bounded by minimum and maximum values, including a +!! maximum smoothing rate for numerical stability (\f$ \kappa_{h} \f$ is calculated internally). +!! +!! \subsection section_filter_module_parameters Module mom_interface_filter parameters +!! +!! | Symbol | Module parameter | +!! | ------ | --------------- | +!! | - | APPLY_INTERFACE_FILTER | +!! | - | INTERFACE_FILTER_TIME | +!! | - | INTERFACE_FILTER_MAX_CFL | +!! | - | INTERFACE_FILTER_ORDER | +!! + +end module MOM_interface_filter diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index dc23042916..87562a9c83 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -17,7 +17,7 @@ module MOM_lateral_mixing_coeffs use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_wave_speed, only : wave_speed, wave_speed_CS, wave_speed_init -use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE +use MOM_open_boundary, only : ocean_OBC_type implicit none ; private @@ -475,16 +475,16 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, US, CS, OBC) call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, dzu=dzu, dzv=dzv, & dzSxN=dzSxN, dzSyN=dzSyN, halo=1, OBC=OBC) - call calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v) + call calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, CS%SN_u, CS%SN_v) else call find_eta(h, tv, G, GV, US, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, US, h, e, tv, dt*CS%kappa_smooth, CS%use_stanley_iso, & CS%slope_x, CS%slope_y, N2_u=N2_u, N2_v=N2_v, halo=1, OBC=OBC) - call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS, OBC) + call calc_Visbeck_coeffs_old(h, CS%slope_x, CS%slope_y, N2_u, N2_v, G, GV, US, CS) else !call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, CS%slope_x, CS%slope_y) - call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true., OBC) + call calc_slope_functions_using_just_e(h, G, GV, US, CS, e, .true.) endif endif endif @@ -507,7 +507,7 @@ end subroutine calc_slope_functions !> Calculates factors used when setting diffusivity coefficients similar to Visbeck et al., 1997. !! This is on older implementation that is susceptible to large values of Eady growth rate !! for incropping layers. -subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS, OBC) +subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] @@ -519,7 +519,6 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C !! at v-points [L2 Z-2 T-2 ~> s-2] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(VarMix_CS), intent(inout) :: CS !< Variable mixing control struct - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real :: S2 ! Interface slope squared [nondim] @@ -533,7 +532,6 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C real :: H_u(SZIB_(G)), H_v(SZI_(G)) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) - logical :: local_open_u_BC, local_open_v_BC if (.not. CS%initialized) call MOM_error(FATAL, "calc_Visbeck_coeffs_old: "// & "Module must be initialized before it is used.") @@ -546,13 +544,6 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - local_open_u_BC = .false. - local_open_v_BC = .false. - if (associated(OBC)) then - local_open_u_BC = OBC%open_u_BCs_exist_globally - local_open_v_BC = OBC%open_v_BCs_exist_globally - endif - S2max = CS%Visbeck_S_max**2 !$OMP parallel do default(shared) @@ -593,20 +584,11 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo ; enddo do I=is-1,ie if (H_u(I)>0.) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * CS%SN_u(I,j) / H_u(I) - S2_u(I,j) = G%mask2dCu(I,j) * S2_u(I,j) / H_u(I) + CS%SN_u(I,j) = G%OBCmaskCu(I,j) * CS%SN_u(I,j) / H_u(I) + S2_u(I,j) = G%OBCmaskCu(I,j) * S2_u(I,j) / H_u(I) else CS%SN_u(I,j) = 0. endif - if (local_open_u_BC) then - l_seg = OBC%segnum_u(I,j) - - if (l_seg /= OBC_NONE) then - if (OBC%segment(l_seg)%open) then - CS%SN_u(i,J) = 0. - endif - endif - endif enddo enddo @@ -638,20 +620,11 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C enddo ; enddo do i=is,ie if (H_v(i)>0.) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * CS%SN_v(i,J) / H_v(i) - S2_v(i,J) = G%mask2dCv(i,J) * S2_v(i,J) / H_v(i) + CS%SN_v(i,J) = G%OBCmaskCv(i,J) * CS%SN_v(i,J) / H_v(i) + S2_v(i,J) = G%OBCmaskCv(i,J) * S2_v(i,J) / H_v(i) else CS%SN_v(i,J) = 0. endif - if (local_open_v_BC) then - l_seg = OBC%segnum_v(i,J) - - if (l_seg /= OBC_NONE) then - if (OBC%segment(OBC%segnum_v(i,J))%open) then - CS%SN_v(i,J) = 0. - endif - endif - endif enddo enddo @@ -673,12 +646,11 @@ subroutine calc_Visbeck_coeffs_old(h, slope_x, slope_y, N2_u, N2_v, G, GV, US, C end subroutine calc_Visbeck_coeffs_old !> Calculates the Eady growth rate (2D fields) for use in MEKE and the Visbeck schemes -subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, dzSyN, SN_u, SN_v) +subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, h, e, dzu, dzv, dzSxN, dzSyN, SN_u, SN_v) type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(ocean_OBC_type), pointer, intent(in) :: OBC !< Open boundaries control structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Interface height [Z ~> m] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface height [Z ~> m] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: dzu !< dz at u-points [Z ~> m] @@ -699,7 +671,7 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d real :: r_crp_dist ! The inverse of the distance over which to scale the cropping [Z-1 ~> m-1] real :: dB, dT ! Elevation variables used when cropping [Z ~> m] integer :: i, j, k, l_seg - logical :: local_open_u_BC, local_open_v_BC, crop + logical :: crop dz_neglect = GV%H_subroundoff * GV%H_to_Z D_scale = CS%Eady_GR_D_scale @@ -707,13 +679,6 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d r_crp_dist = 1. / max( dz_neglect, CS%cropping_distance ) crop = CS%cropping_distance>=0. ! Only filter out in-/out-cropped interface is parameter if non-negative - local_open_u_BC = .false. - local_open_v_BC = .false. - if (associated(OBC)) then - local_open_u_BC = OBC%open_u_BCs_exist_globally - local_open_v_BC = OBC%open_v_BCs_exist_globally - endif - if (CS%debug) then call uvchksum("calc_Eady_growth_rate_2D dz[uv]", dzu, dzv, G%HI, scale=US%Z_to_m, scalar_pair=.true.) call uvchksum("calc_Eady_growth_rate_2D dzS2N2[uv]", dzSxN, dzSyN, G%HI, & @@ -764,19 +729,9 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d enddo ; enddo endif do I=G%isc-1,G%iec - CS%SN_u(I,j) = G%mask2dCu(I,j) * ( vint_SN(I) / sum_dz(I) ) - SN_cpy(I,j) = G%mask2dCu(I,j) * ( vint_SN(I) / sum_dz(I) ) + CS%SN_u(I,j) = G%OBCmaskCu(I,j) * ( vint_SN(I) / sum_dz(I) ) + SN_cpy(I,j) = G%OBCmaskCu(I,j) * ( vint_SN(I) / sum_dz(I) ) enddo - if (local_open_u_BC) then - do I=G%isc-1,G%iec - l_seg = OBC%segnum_u(I,j) - if (l_seg /= OBC_NONE) then - if (OBC%segment(l_seg)%open) then - CS%SN_u(i,J) = 0. - endif - endif - enddo - endif enddo !$OMP parallel do default(shared) private(dnew,dz,weight,l_seg) @@ -817,18 +772,8 @@ subroutine calc_Eady_growth_rate_2D(CS, G, GV, US, OBC, h, e, dzu, dzv, dzSxN, d enddo ; enddo endif do i=G%isc-1,G%iec+1 - CS%SN_v(i,J) = G%mask2dCv(i,J) * ( vint_SN(i) / sum_dz(i) ) + CS%SN_v(i,J) = G%OBCmaskCv(i,J) * ( vint_SN(i) / sum_dz(i) ) enddo - if (local_open_v_BC) then - do i=G%isc-1,G%iec+1 - l_seg = OBC%segnum_v(i,J) - if (l_seg /= OBC_NONE) then - if (OBC%segment(l_seg)%open) then - CS%SN_v(i,J) = 0. - endif - endif - enddo - endif enddo do j = G%jsc,G%jec @@ -855,7 +800,7 @@ end subroutine calc_Eady_growth_rate_2D !> The original calc_slope_function() that calculated slopes using !! interface positions only, not accounting for density variations. -subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes, OBC) +subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slopes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thickness [H ~> m or kg m-2] @@ -864,7 +809,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(in) :: e !< Interface position [Z ~> m] logical, intent(in) :: calculate_slopes !< If true, calculate slopes !! internally otherwise use slopes stored in CS - type(ocean_OBC_type), pointer :: OBC !< Open boundaries control structure. ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points [nondim] (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at v points [nondim] (for diagnostics) @@ -881,7 +825,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop integer :: l_seg real :: S2N2_u_local(SZIB_(G), SZJ_(G),SZK_(GV)) real :: S2N2_v_local(SZI_(G), SZJB_(G),SZK_(GV)) - logical :: local_open_u_BC, local_open_v_BC if (.not. CS%initialized) call MOM_error(FATAL, "calc_slope_functions_using_just_e: "// & "Module must be initialized before it is used.") @@ -894,13 +837,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - local_open_u_BC = .false. - local_open_v_BC = .false. - if (associated(OBC)) then - local_open_u_BC = OBC%open_u_BCs_exist_globally - local_open_v_BC = OBC%open_v_BCs_exist_globally - endif - one_meter = 1.0 * GV%m_to_H h_neglect = GV%H_subroundoff H_cutoff = real(2*nz) * (GV%Angstrom_H + h_neglect) @@ -972,20 +908,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop !SN_u(I,j) = sqrt( SN_u(I,j) / ( max(G%bathyT(i,j), G%bathyT(i+1,j)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then - CS%SN_u(I,j) = G%mask2dCu(I,j) * sqrt( CS%SN_u(I,j) / & + CS%SN_u(I,j) = G%OBCmaskCu(I,j) * sqrt( CS%SN_u(I,j) / & (max(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref) ) else CS%SN_u(I,j) = 0.0 endif - if (local_open_u_BC) then - l_seg = OBC%segnum_u(I,j) - - if (l_seg /= OBC_NONE) then - if (OBC%segment(l_seg)%open) then - CS%SN_u(I,j) = 0. - endif - endif - endif enddo enddo !$OMP parallel do default(shared) @@ -999,20 +926,11 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, US, CS, e, calculate_slop !SN_v(i,J) = sqrt( SN_v(i,J) / ( max(G%bathyT(i,J), G%bathyT(i,J+1)) + (G%Z_ref + GV%Angstrom_Z) ) ) !The code below behaves better than the line above. Not sure why? AJA if ( min(G%bathyT(i,j), G%bathyT(i+1,j)) + G%Z_ref > H_cutoff*GV%H_to_Z ) then - CS%SN_v(i,J) = G%mask2dCv(i,J) * sqrt( CS%SN_v(i,J) / & + CS%SN_v(i,J) = G%OBCmaskCv(i,J) * sqrt( CS%SN_v(i,J) / & (max(G%bathyT(i,j), G%bathyT(i,j+1)) + G%Z_ref) ) else CS%SN_v(i,J) = 0.0 endif - if (local_open_v_BC) then - l_seg = OBC%segnum_v(i,J) - - if (l_seg /= OBC_NONE) then - if (OBC%segment(OBC%segnum_v(i,J))%open) then - CS%SN_v(i,J) = 0. - endif - endif - endif enddo enddo diff --git a/src/parameterizations/lateral/MOM_load_love_numbers.F90 b/src/parameterizations/lateral/MOM_load_love_numbers.F90 new file mode 100644 index 0000000000..84819b5915 --- /dev/null +++ b/src/parameterizations/lateral/MOM_load_love_numbers.F90 @@ -0,0 +1,1484 @@ +!> Load Love Numbers for degree range [0, 1440] +module MOM_load_love_numbers + +implicit none ; private + +public Love_Data + +integer, parameter :: lmax = 1440 !< Maximum degree of the stored Love numbers +real, dimension(4, lmax+1), parameter :: & + Love_Data = & + reshape((/ 0.0, 0.0000000000, 0.0000000000 , -1.0000000000 , & + 1.0, -1.2858777580,-8.9608179370e-1, -1.0000000000 , & + 2.0, -0.9907994900, 2.3286695000e-2, -3.0516104000e-1, & + 3.0, -1.0499631000, 6.9892136000e-2, -1.9585733000e-1, & + 4.0, -1.0526477000, 5.8670467000e-2, -1.3352284000e-1, & + 5.0, -1.0855918000, 4.6165153000e-2, -1.0456531000e-1, & + 6.0, -1.1431163000, 3.8586926000e-2, -9.0184841000e-2, & + 7.0, -1.2116273000, 3.4198827000e-2, -8.1906787000e-2, & + 8.0, -1.2831157000, 3.1474998000e-2, -7.6379141000e-2, & + 9.0, -1.3538554000, 2.9624407000e-2, -7.2250183000e-2, & + 10.0, -1.4223516000, 2.8273961000e-2, -6.8934145000e-2, & + 11.0, -1.4881117000, 2.7242278000e-2, -6.6147992000e-2, & + 12.0, -1.5510428000, 2.6431124000e-2, -6.3736253000e-2, & + 13.0, -1.6111895000, 2.5779507000e-2, -6.1602870000e-2, & + 14.0, -1.6686329000, 2.5245139000e-2, -5.9683159000e-2, & + 15.0, -1.7234569000, 2.4796803000e-2, -5.7931180000e-2, & + 16.0, -1.7757418000, 2.4410861000e-2, -5.6313294000e-2, & + 17.0, -1.8255646000, 2.4069336000e-2, -5.4804452000e-2, & + 18.0, -1.8730019000, 2.3758645000e-2, -5.3385807000e-2, & + 19.0, -1.9181321000, 2.3468646000e-2, -5.2043088000e-2, & + 20.0, -1.9610366000, 2.3191893000e-2, -5.0765423000e-2, & + 21.0, -2.0018000000, 2.2923032000e-2, -4.9544487000e-2, & + 22.0, -2.0405101000, 2.2658321000e-2, -4.8373866000e-2, & + 23.0, -2.0772571000, 2.2395242000e-2, -4.7248575000e-2, & + 24.0, -2.1121328000, 2.2132200000e-2, -4.6164708000e-2, & + 25.0, -2.1452296000, 2.1868280000e-2, -4.5119160000e-2, & + 26.0, -2.1766398000, 2.1603063000e-2, -4.4109431000e-2, & + 27.0, -2.2064546000, 2.1336479000e-2, -4.3133464000e-2, & + 28.0, -2.2347634000, 2.1068700000e-2, -4.2189540000e-2, & + 29.0, -2.2616531000, 2.0800053000e-2, -4.1276184000e-2, & + 30.0, -2.2872080000, 2.0530962000e-2, -4.0392105000e-2, & + 31.0, -2.3115088000, 2.0261897000e-2, -3.9536148000e-2, & + 32.0, -2.3346328000, 1.9993346000e-2, -3.8707260000e-2, & + 33.0, -2.3566536000, 1.9725790000e-2, -3.7904463000e-2, & + 34.0, -2.3776409000, 1.9459686000e-2, -3.7126837000e-2, & + 35.0, -2.3976605000, 1.9195459000e-2, -3.6373510000e-2, & + 36.0, -2.4167746000, 1.8933494000e-2, -3.5643644000e-2, & + 37.0, -2.4350414000, 1.8674136000e-2, -3.4936432000e-2, & + 38.0, -2.4525156000, 1.8417687000e-2, -3.4251094000e-2, & + 39.0, -2.4692484000, 1.8164407000e-2, -3.3586873000e-2, & + 40.0, -2.4852876000, 1.7914518000e-2, -3.2943035000e-2, & + 41.0, -2.5006779000, 1.7668203000e-2, -3.2318866000e-2, & + 42.0, -2.5154609000, 1.7425613000e-2, -3.1713675000e-2, & + 43.0, -2.5296755000, 1.7186866000e-2, -3.1126789000e-2, & + 44.0, -2.5433577000, 1.6952053000e-2, -3.0557557000e-2, & + 45.0, -2.5565412000, 1.6721240000e-2, -3.0005347000e-2, & + 46.0, -2.5692574000, 1.6494470000e-2, -2.9469547000e-2, & + 47.0, -2.5815353000, 1.6271769000e-2, -2.8949568000e-2, & + 48.0, -2.5934022000, 1.6053144000e-2, -2.8444838000e-2, & + 49.0, -2.6048833000, 1.5838586000e-2, -2.7954806000e-2, & + 50.0, -2.6160021000, 1.5628077000e-2, -2.7478940000e-2, & + 51.0, -2.6267805000, 1.5421585000e-2, -2.7016729000e-2, & + 52.0, -2.6372389000, 1.5219071000e-2, -2.6567679000e-2, & + 53.0, -2.6473964000, 1.5020486000e-2, -2.6131317000e-2, & + 54.0, -2.6572706000, 1.4825779000e-2, -2.5707185000e-2, & + 55.0, -2.6668781000, 1.4634888000e-2, -2.5294846000e-2, & + 56.0, -2.6762345000, 1.4447752000e-2, -2.4893877000e-2, & + 57.0, -2.6853540000, 1.4264303000e-2, -2.4503874000e-2, & + 58.0, -2.6942503000, 1.4084474000e-2, -2.4124449000e-2, & + 59.0, -2.7029358000, 1.3908192000e-2, -2.3755228000e-2, & + 60.0, -2.7114225000, 1.3735386000e-2, -2.3395852000e-2, & + 61.0, -2.7197214000, 1.3565983000e-2, -2.3045980000e-2, & + 62.0, -2.7278428000, 1.3399909000e-2, -2.2705280000e-2, & + 63.0, -2.7357965000, 1.3237092000e-2, -2.2373437000e-2, & + 64.0, -2.7435916000, 1.3077458000e-2, -2.2050147000e-2, & + 65.0, -2.7512366000, 1.2920935000e-2, -2.1735119000e-2, & + 66.0, -2.7587397000, 1.2767451000e-2, -2.1428073000e-2, & + 67.0, -2.7661083000, 1.2616936000e-2, -2.1128742000e-2, & + 68.0, -2.7733496000, 1.2469319000e-2, -2.0836869000e-2, & + 69.0, -2.7804703000, 1.2324532000e-2, -2.0552206000e-2, & + 70.0, -2.7874767000, 1.2182508000e-2, -2.0274516000e-2, & + 71.0, -2.7943748000, 1.2043181000e-2, -2.0003572000e-2, & + 72.0, -2.8011702000, 1.1906487000e-2, -1.9739156000e-2, & + 73.0, -2.8078682000, 1.1772362000e-2, -1.9481058000e-2, & + 74.0, -2.8144738000, 1.1640746000e-2, -1.9229076000e-2, & + 75.0, -2.8209918000, 1.1511578000e-2, -1.8983017000e-2, & + 76.0, -2.8274266000, 1.1384799000e-2, -1.8742695000e-2, & + 77.0, -2.8337824000, 1.1260352000e-2, -1.8507931000e-2, & + 78.0, -2.8400633000, 1.1138183000e-2, -1.8278553000e-2, & + 79.0, -2.8462730000, 1.1018236000e-2, -1.8054395000e-2, & + 80.0, -2.8524152000, 1.0900460000e-2, -1.7835300000e-2, & + 81.0, -2.8584932000, 1.0784802000e-2, -1.7621113000e-2, & + 82.0, -2.8645103000, 1.0671213000e-2, -1.7411688000e-2, & + 83.0, -2.8704696000, 1.0559645000e-2, -1.7206882000e-2, & + 84.0, -2.8763739000, 1.0450051000e-2, -1.7006560000e-2, & + 85.0, -2.8822260000, 1.0342384000e-2, -1.6810590000e-2, & + 86.0, -2.8880285000, 1.0236599000e-2, -1.6618845000e-2, & + 87.0, -2.8937839000, 1.0132655000e-2, -1.6431203000e-2, & + 88.0, -2.8994945000, 1.0030508000e-2, -1.6247547000e-2, & + 89.0, -2.9051627000, 9.9301169000e-3, -1.6067762000e-2, & + 90.0, -2.9107905000, 9.8314429000e-3, -1.5891741000e-2, & + 91.0, -2.9163799000, 9.7344467000e-3, -1.5719376000e-2, & + 92.0, -2.9219330000, 9.6390907000e-3, -1.5550567000e-2, & + 93.0, -2.9274514000, 9.5453383000e-3, -1.5385215000e-2, & + 94.0, -2.9329370000, 9.4531538000e-3, -1.5223225000e-2, & + 95.0, -2.9383913000, 9.3625026000e-3, -1.5064506000e-2, & + 96.0, -2.9438161000, 9.2733509000e-3, -1.4908968000e-2, & + 97.0, -2.9492127000, 9.1856660000e-3, -1.4756526000e-2, & + 98.0, -2.9545826000, 9.0994159000e-3, -1.4607099000e-2, & + 99.0, -2.9599272000, 9.0145695000e-3, -1.4460604000e-2, & + 100.0, -2.9652476000, 8.9310967000e-3, -1.4316967000e-2, & + 101.0, -2.9705453000, 8.8489681000e-3, -1.4176111000e-2, & + 102.0, -2.9758213000, 8.7681548000e-3, -1.4037965000e-2, & + 103.0, -2.9810767000, 8.6886292000e-3, -1.3902458000e-2, & + 104.0, -2.9863125000, 8.6103640000e-3, -1.3769523000e-2, & + 105.0, -2.9915299000, 8.5333328000e-3, -1.3639094000e-2, & + 106.0, -2.9967298000, 8.4575097000e-3, -1.3511108000e-2, & + 107.0, -3.0019129000, 8.3828699000e-3, -1.3385503000e-2, & + 108.0, -3.0070803000, 8.3093886000e-3, -1.3262220000e-2, & + 109.0, -3.0122328000, 8.2370423000e-3, -1.3141201000e-2, & + 110.0, -3.0173710000, 8.1658076000e-3, -1.3022390000e-2, & + 111.0, -3.0224958000, 8.0956619000e-3, -1.2905734000e-2, & + 112.0, -3.0276079000, 8.0265832000e-3, -1.2791179000e-2, & + 113.0, -3.0327080000, 7.9585500000e-3, -1.2678675000e-2, & + 114.0, -3.0377966000, 7.8915413000e-3, -1.2568172000e-2, & + 115.0, -3.0428744000, 7.8255367000e-3, -1.2459622000e-2, & + 116.0, -3.0479420000, 7.7605163000e-3, -1.2352979000e-2, & + 117.0, -3.0529999000, 7.6964606000e-3, -1.2248198000e-2, & + 118.0, -3.0580486000, 7.6333507000e-3, -1.2145235000e-2, & + 119.0, -3.0630887000, 7.5711680000e-3, -1.2044048000e-2, & + 120.0, -3.0681205000, 7.5098946000e-3, -1.1944594000e-2, & + 121.0, -3.0731446000, 7.4495128000e-3, -1.1846835000e-2, & + 122.0, -3.0781614000, 7.3900054000e-3, -1.1750732000e-2, & + 123.0, -3.0831713000, 7.3313557000e-3, -1.1656245000e-2, & + 124.0, -3.0881747000, 7.2735474000e-3, -1.1563340000e-2, & + 125.0, -3.0931718000, 7.2165644000e-3, -1.1471980000e-2, & + 126.0, -3.0981632000, 7.1603911000e-3, -1.1382130000e-2, & + 127.0, -3.1031490000, 7.1050124000e-3, -1.1293757000e-2, & + 128.0, -3.1081296000, 7.0504134000e-3, -1.1206828000e-2, & + 129.0, -3.1131054000, 6.9965795000e-3, -1.1121311000e-2, & + 130.0, -3.1180765000, 6.9434967000e-3, -1.1037175000e-2, & + 131.0, -3.1230433000, 6.8911509000e-3, -1.0954391000e-2, & + 132.0, -3.1280059000, 6.8395288000e-3, -1.0872928000e-2, & + 133.0, -3.1329647000, 6.7886171000e-3, -1.0792758000e-2, & + 134.0, -3.1379199000, 6.7384029000e-3, -1.0713853000e-2, & + 135.0, -3.1428716000, 6.6888735000e-3, -1.0636187000e-2, & + 136.0, -3.1478201000, 6.6400168000e-3, -1.0559733000e-2, & + 137.0, -3.1527656000, 6.5918206000e-3, -1.0484466000e-2, & + 138.0, -3.1577082000, 6.5442732000e-3, -1.0410360000e-2, & + 139.0, -3.1626481000, 6.4973631000e-3, -1.0337392000e-2, & + 140.0, -3.1675855000, 6.4510790000e-3, -1.0265537000e-2, & + 141.0, -3.1725205000, 6.4054099000e-3, -1.0194773000e-2, & + 142.0, -3.1774533000, 6.3603452000e-3, -1.0125078000e-2, & + 143.0, -3.1823840000, 6.3158742000e-3, -1.0056429000e-2, & + 144.0, -3.1873127000, 6.2719868000e-3, -9.9888045000e-3, & + 145.0, -3.1922396000, 6.2286729000e-3, -9.9221850000e-3, & + 146.0, -3.1971648000, 6.1859227000e-3, -9.8565496000e-3, & + 147.0, -3.2020883000, 6.1437265000e-3, -9.7918788000e-3, & + 148.0, -3.2070102000, 6.1020749000e-3, -9.7281532000e-3, & + 149.0, -3.2119308000, 6.0609589000e-3, -9.6653542000e-3, & + 150.0, -3.2168500000, 6.0203693000e-3, -9.6034635000e-3, & + 151.0, -3.2217679000, 5.9802974000e-3, -9.5424633000e-3, & + 152.0, -3.2266847000, 5.9407346000e-3, -9.4823362000e-3, & + 153.0, -3.2316003000, 5.9016724000e-3, -9.4230652000e-3, & + 154.0, -3.2365149000, 5.8631026000e-3, -9.3646338000e-3, & + 155.0, -3.2414284000, 5.8250172000e-3, -9.3070259000e-3, & + 156.0, -3.2463411000, 5.7874081000e-3, -9.2502257000e-3, & + 157.0, -3.2512529000, 5.7502678000e-3, -9.1942178000e-3, & + 158.0, -3.2561639000, 5.7135886000e-3, -9.1389873000e-3, & + 159.0, -3.2610741000, 5.6773630000e-3, -9.0845194000e-3, & + 160.0, -3.2659835000, 5.6415839000e-3, -9.0308000000e-3, & + 161.0, -3.2708923000, 5.6062442000e-3, -8.9778149000e-3, & + 162.0, -3.2758004000, 5.5713368000e-3, -8.9255506000e-3, & + 163.0, -3.2807079000, 5.5368550000e-3, -8.8739938000e-3, & + 164.0, -3.2856148000, 5.5027920000e-3, -8.8231314000e-3, & + 165.0, -3.2905211000, 5.4691413000e-3, -8.7729507000e-3, & + 166.0, -3.2954269000, 5.4358966000e-3, -8.7234394000e-3, & + 167.0, -3.3003322000, 5.4030515000e-3, -8.6745852000e-3, & + 168.0, -3.3052370000, 5.3705998000e-3, -8.6263763000e-3, & + 169.0, -3.3101414000, 5.3385356000e-3, -8.5788012000e-3, & + 170.0, -3.3150452000, 5.3068529000e-3, -8.5318484000e-3, & + 171.0, -3.3199486000, 5.2755459000e-3, -8.4855070000e-3, & + 172.0, -3.3248516000, 5.2446089000e-3, -8.4397661000e-3, & + 173.0, -3.3297541000, 5.2140364000e-3, -8.3946150000e-3, & + 174.0, -3.3346563000, 5.1838229000e-3, -8.3500435000e-3, & + 175.0, -3.3395580000, 5.1539630000e-3, -8.3060415000e-3, & + 176.0, -3.3444593000, 5.1244515000e-3, -8.2625990000e-3, & + 177.0, -3.3493602000, 5.0952833000e-3, -8.2197063000e-3, & + 178.0, -3.3542607000, 5.0664532000e-3, -8.1773539000e-3, & + 179.0, -3.3591609000, 5.0379563000e-3, -8.1355327000e-3, & + 180.0, -3.3640606000, 5.0097879000e-3, -8.0942335000e-3, & + 181.0, -3.3689599000, 4.9819430000e-3, -8.0534474000e-3, & + 182.0, -3.3738588000, 4.9544170000e-3, -8.0131658000e-3, & + 183.0, -3.3787572000, 4.9272053000e-3, -7.9733801000e-3, & + 184.0, -3.3836553000, 4.9003034000e-3, -7.9340821000e-3, & + 185.0, -3.3885529000, 4.8737069000e-3, -7.8952635000e-3, & + 186.0, -3.3934501000, 4.8474114000e-3, -7.8569164000e-3, & + 187.0, -3.3983469000, 4.8214127000e-3, -7.8190330000e-3, & + 188.0, -3.4032432000, 4.7957066000e-3, -7.7816057000e-3, & + 189.0, -3.4081390000, 4.7702889000e-3, -7.7446269000e-3, & + 190.0, -3.4130344000, 4.7451557000e-3, -7.7080893000e-3, & + 191.0, -3.4179292000, 4.7203030000e-3, -7.6719857000e-3, & + 192.0, -3.4228236000, 4.6957268000e-3, -7.6363091000e-3, & + 193.0, -3.4277174000, 4.6714235000e-3, -7.6010526000e-3, & + 194.0, -3.4326107000, 4.6473891000e-3, -7.5662095000e-3, & + 195.0, -3.4375035000, 4.6236200000e-3, -7.5317730000e-3, & + 196.0, -3.4423957000, 4.6001126000e-3, -7.4977367000e-3, & + 197.0, -3.4472873000, 4.5768634000e-3, -7.4640943000e-3, & + 198.0, -3.4521783000, 4.5538688000e-3, -7.4308395000e-3, & + 199.0, -3.4570687000, 4.5311254000e-3, -7.3979662000e-3, & + 200.0, -3.4619585000, 4.5086298000e-3, -7.3654685000e-3, & + 201.0, -3.4668476000, 4.4863788000e-3, -7.3333403000e-3, & + 202.0, -3.4717360000, 4.4643689000e-3, -7.3015761000e-3, & + 203.0, -3.4766237000, 4.4425971000e-3, -7.2701701000e-3, & + 204.0, -3.4815107000, 4.4210601000e-3, -7.2391168000e-3, & + 205.0, -3.4863970000, 4.3997550000e-3, -7.2084108000e-3, & + 206.0, -3.4912825000, 4.3786785000e-3, -7.1780467000e-3, & + 207.0, -3.4961672000, 4.3578278000e-3, -7.1480193000e-3, & + 208.0, -3.5010512000, 4.3371999000e-3, -7.1183236000e-3, & + 209.0, -3.5059343000, 4.3167918000e-3, -7.0889544000e-3, & + 210.0, -3.5108165000, 4.2966008000e-3, -7.0599068000e-3, & + 211.0, -3.5156979000, 4.2766239000e-3, -7.0311760000e-3, & + 212.0, -3.5205784000, 4.2568586000e-3, -7.0027573000e-3, & + 213.0, -3.5254580000, 4.2373019000e-3, -6.9746460000e-3, & + 214.0, -3.5303366000, 4.2179514000e-3, -6.9468375000e-3, & + 215.0, -3.5352143000, 4.1988043000e-3, -6.9193272000e-3, & + 216.0, -3.5400909000, 4.1798580000e-3, -6.8921109000e-3, & + 217.0, -3.5449666000, 4.1611101000e-3, -6.8651842000e-3, & + 218.0, -3.5498412000, 4.1425580000e-3, -6.8385428000e-3, & + 219.0, -3.5547147000, 4.1241992000e-3, -6.8121826000e-3, & + 220.0, -3.5595871000, 4.1060313000e-3, -6.7860995000e-3, & + 221.0, -3.5644584000, 4.0880520000e-3, -6.7602894000e-3, & + 222.0, -3.5693286000, 4.0702588000e-3, -6.7347484000e-3, & + 223.0, -3.5741976000, 4.0526495000e-3, -6.7094726000e-3, & + 224.0, -3.5790654000, 4.0352217000e-3, -6.6844583000e-3, & + 225.0, -3.5839320000, 4.0179733000e-3, -6.6597016000e-3, & + 226.0, -3.5887973000, 4.0009020000e-3, -6.6351989000e-3, & + 227.0, -3.5936613000, 3.9840057000e-3, -6.6109466000e-3, & + 228.0, -3.5985240000, 3.9672821000e-3, -6.5869411000e-3, & + 229.0, -3.6033854000, 3.9507293000e-3, -6.5631791000e-3, & + 230.0, -3.6082455000, 3.9343450000e-3, -6.5396569000e-3, & + 231.0, -3.6131041000, 3.9181273000e-3, -6.5163713000e-3, & + 232.0, -3.6179613000, 3.9020742000e-3, -6.4933190000e-3, & + 233.0, -3.6228171000, 3.8861836000e-3, -6.4704966000e-3, & + 234.0, -3.6276714000, 3.8704536000e-3, -6.4479012000e-3, & + 235.0, -3.6325242000, 3.8548822000e-3, -6.4255293000e-3, & + 236.0, -3.6373754000, 3.8394677000e-3, -6.4033781000e-3, & + 237.0, -3.6422252000, 3.8242080000e-3, -6.3814445000e-3, & + 238.0, -3.6470733000, 3.8091013000e-3, -6.3597254000e-3, & + 239.0, -3.6519198000, 3.7941458000e-3, -6.3382179000e-3, & + 240.0, -3.6567647000, 3.7793398000e-3, -6.3169193000e-3, & + 241.0, -3.6616079000, 3.7646814000e-3, -6.2958265000e-3, & + 242.0, -3.6664494000, 3.7501690000e-3, -6.2749370000e-3, & + 243.0, -3.6712891000, 3.7358007000e-3, -6.2542478000e-3, & + 244.0, -3.6761271000, 3.7215749000e-3, -6.2337563000e-3, & + 245.0, -3.6809634000, 3.7074899000e-3, -6.2134599000e-3, & + 246.0, -3.6857978000, 3.6935441000e-3, -6.1933559000e-3, & + 247.0, -3.6906303000, 3.6797359000e-3, -6.1734419000e-3, & + 248.0, -3.6954610000, 3.6660636000e-3, -6.1537152000e-3, & + 249.0, -3.7002898000, 3.6525257000e-3, -6.1341734000e-3, & + 250.0, -3.7051167000, 3.6391206000e-3, -6.1148140000e-3, & + 251.0, -3.7099416000, 3.6258468000e-3, -6.0956346000e-3, & + 252.0, -3.7147645000, 3.6127027000e-3, -6.0766330000e-3, & + 253.0, -3.7195854000, 3.5996869000e-3, -6.0578067000e-3, & + 254.0, -3.7244043000, 3.5867979000e-3, -6.0391534000e-3, & + 255.0, -3.7292211000, 3.5740342000e-3, -6.0206710000e-3, & + 256.0, -3.7340357000, 3.5613944000e-3, -6.0023572000e-3, & + 257.0, -3.7388483000, 3.5488772000e-3, -5.9842098000e-3, & + 258.0, -3.7436587000, 3.5364810000e-3, -5.9662266000e-3, & + 259.0, -3.7484669000, 3.5242045000e-3, -5.9484056000e-3, & + 260.0, -3.7532729000, 3.5120464000e-3, -5.9307447000e-3, & + 261.0, -3.7580766000, 3.5000053000e-3, -5.9132419000e-3, & + 262.0, -3.7628780000, 3.4880799000e-3, -5.8958950000e-3, & + 263.0, -3.7676772000, 3.4762689000e-3, -5.8787022000e-3, & + 264.0, -3.7724740000, 3.4645710000e-3, -5.8616614000e-3, & + 265.0, -3.7772685000, 3.4529849000e-3, -5.8447709000e-3, & + 266.0, -3.7820605000, 3.4415093000e-3, -5.8280285000e-3, & + 267.0, -3.7868501000, 3.4301431000e-3, -5.8114326000e-3, & + 268.0, -3.7916373000, 3.4188851000e-3, -5.7949812000e-3, & + 269.0, -3.7964220000, 3.4077339000e-3, -5.7786726000e-3, & + 270.0, -3.8012042000, 3.3966884000e-3, -5.7625050000e-3, & + 271.0, -3.8059839000, 3.3857475000e-3, -5.7464766000e-3, & + 272.0, -3.8107610000, 3.3749099000e-3, -5.7305857000e-3, & + 273.0, -3.8155355000, 3.3641746000e-3, -5.7148305000e-3, & + 274.0, -3.8203074000, 3.3535404000e-3, -5.6992095000e-3, & + 275.0, -3.8250766000, 3.3430061000e-3, -5.6837210000e-3, & + 276.0, -3.8298432000, 3.3325707000e-3, -5.6683633000e-3, & + 277.0, -3.8346070000, 3.3222331000e-3, -5.6531348000e-3, & + 278.0, -3.8393682000, 3.3119922000e-3, -5.6380340000e-3, & + 279.0, -3.8441265000, 3.3018470000e-3, -5.6230593000e-3, & + 280.0, -3.8488821000, 3.2917964000e-3, -5.6082092000e-3, & + 281.0, -3.8536348000, 3.2818393000e-3, -5.5934822000e-3, & + 282.0, -3.8583847000, 3.2719748000e-3, -5.5788767000e-3, & + 283.0, -3.8631317000, 3.2622018000e-3, -5.5643913000e-3, & + 284.0, -3.8678759000, 3.2525193000e-3, -5.5500246000e-3, & + 285.0, -3.8726170000, 3.2429264000e-3, -5.5357752000e-3, & + 286.0, -3.8773553000, 3.2334221000e-3, -5.5216416000e-3, & + 287.0, -3.8820905000, 3.2240054000e-3, -5.5076224000e-3, & + 288.0, -3.8868227000, 3.2146753000e-3, -5.4937164000e-3, & + 289.0, -3.8915519000, 3.2054310000e-3, -5.4799221000e-3, & + 290.0, -3.8962780000, 3.1962715000e-3, -5.4662383000e-3, & + 291.0, -3.9010010000, 3.1871958000e-3, -5.4526635000e-3, & + 292.0, -3.9057209000, 3.1782032000e-3, -5.4391967000e-3, & + 293.0, -3.9104377000, 3.1692926000e-3, -5.4258363000e-3, & + 294.0, -3.9151512000, 3.1604632000e-3, -5.4125813000e-3, & + 295.0, -3.9198616000, 3.1517142000e-3, -5.3994305000e-3, & + 296.0, -3.9245687000, 3.1430446000e-3, -5.3863824000e-3, & + 297.0, -3.9292725000, 3.1344537000e-3, -5.3734361000e-3, & + 298.0, -3.9339731000, 3.1259405000e-3, -5.3605902000e-3, & + 299.0, -3.9386704000, 3.1175043000e-3, -5.3478437000e-3, & + 300.0, -3.9433643000, 3.1091442000e-3, -5.3351954000e-3, & + 301.0, -3.9480548000, 3.1008594000e-3, -5.3226441000e-3, & + 302.0, -3.9527420000, 3.0926491000e-3, -5.3101888000e-3, & + 303.0, -3.9574257000, 3.0845126000e-3, -5.2978283000e-3, & + 304.0, -3.9621060000, 3.0764490000e-3, -5.2855615000e-3, & + 305.0, -3.9667828000, 3.0684575000e-3, -5.2733874000e-3, & + 306.0, -3.9714561000, 3.0605375000e-3, -5.2613050000e-3, & + 307.0, -3.9761259000, 3.0526881000e-3, -5.2493131000e-3, & + 308.0, -3.9807921000, 3.0449085000e-3, -5.2374107000e-3, & + 309.0, -3.9854548000, 3.0371982000e-3, -5.2255969000e-3, & + 310.0, -3.9901138000, 3.0295562000e-3, -5.2138707000e-3, & + 311.0, -3.9947693000, 3.0219820000e-3, -5.2022310000e-3, & + 312.0, -3.9994210000, 3.0144747000e-3, -5.1906768000e-3, & + 313.0, -4.0040691000, 3.0070337000e-3, -5.1792073000e-3, & + 314.0, -4.0087135000, 2.9996584000e-3, -5.1678215000e-3, & + 315.0, -4.0133542000, 2.9923479000e-3, -5.1565183000e-3, & + 316.0, -4.0179911000, 2.9851016000e-3, -5.1452970000e-3, & + 317.0, -4.0226242000, 2.9779189000e-3, -5.1341566000e-3, & + 318.0, -4.0272535000, 2.9707990000e-3, -5.1230962000e-3, & + 319.0, -4.0318790000, 2.9637414000e-3, -5.1121150000e-3, & + 320.0, -4.0365006000, 2.9567453000e-3, -5.1012119000e-3, & + 321.0, -4.0411184000, 2.9498101000e-3, -5.0903863000e-3, & + 322.0, -4.0457322000, 2.9429353000e-3, -5.0796372000e-3, & + 323.0, -4.0503421000, 2.9361201000e-3, -5.0689638000e-3, & + 324.0, -4.0549481000, 2.9293639000e-3, -5.0583652000e-3, & + 325.0, -4.0595501000, 2.9226662000e-3, -5.0478407000e-3, & + 326.0, -4.0641480000, 2.9160263000e-3, -5.0373894000e-3, & + 327.0, -4.0687420000, 2.9094435000e-3, -5.0270106000e-3, & + 328.0, -4.0733319000, 2.9029174000e-3, -5.0167034000e-3, & + 329.0, -4.0779177000, 2.8964474000e-3, -5.0064671000e-3, & + 330.0, -4.0824995000, 2.8900327000e-3, -4.9963009000e-3, & + 331.0, -4.0870771000, 2.8836730000e-3, -4.9862041000e-3, & + 332.0, -4.0916505000, 2.8773676000e-3, -4.9761758000e-3, & + 333.0, -4.0962198000, 2.8711159000e-3, -4.9662155000e-3, & + 334.0, -4.1007850000, 2.8649173000e-3, -4.9563223000e-3, & + 335.0, -4.1053459000, 2.8587715000e-3, -4.9464955000e-3, & + 336.0, -4.1099025000, 2.8526777000e-3, -4.9367344000e-3, & + 337.0, -4.1144549000, 2.8466354000e-3, -4.9270384000e-3, & + 338.0, -4.1190030000, 2.8406442000e-3, -4.9174066000e-3, & + 339.0, -4.1235469000, 2.8347035000e-3, -4.9078386000e-3, & + 340.0, -4.1280863000, 2.8288128000e-3, -4.8983335000e-3, & + 341.0, -4.1326215000, 2.8229715000e-3, -4.8888907000e-3, & + 342.0, -4.1371523000, 2.8171792000e-3, -4.8795095000e-3, & + 343.0, -4.1416786000, 2.8114353000e-3, -4.8701893000e-3, & + 344.0, -4.1462006000, 2.8057394000e-3, -4.8609295000e-3, & + 345.0, -4.1507181000, 2.8000909000e-3, -4.8517295000e-3, & + 346.0, -4.1552312000, 2.7944894000e-3, -4.8425885000e-3, & + 347.0, -4.1597397000, 2.7889344000e-3, -4.8335060000e-3, & + 348.0, -4.1642438000, 2.7834254000e-3, -4.8244814000e-3, & + 349.0, -4.1687434000, 2.7779620000e-3, -4.8155141000e-3, & + 350.0, -4.1732384000, 2.7725436000e-3, -4.8066034000e-3, & + 351.0, -4.1777288000, 2.7671698000e-3, -4.7977488000e-3, & + 352.0, -4.1822147000, 2.7618402000e-3, -4.7889498000e-3, & + 353.0, -4.1866959000, 2.7565543000e-3, -4.7802057000e-3, & + 354.0, -4.1911725000, 2.7513117000e-3, -4.7715160000e-3, & + 355.0, -4.1956445000, 2.7461118000e-3, -4.7628800000e-3, & + 356.0, -4.2001118000, 2.7409544000e-3, -4.7542974000e-3, & + 357.0, -4.2045744000, 2.7358388000e-3, -4.7457675000e-3, & + 358.0, -4.2090323000, 2.7307648000e-3, -4.7372897000e-3, & + 359.0, -4.2134854000, 2.7257319000e-3, -4.7288636000e-3, & + 360.0, -4.2179338000, 2.7207397000e-3, -4.7204886000e-3, & + 361.0, -4.2223775000, 2.7157877000e-3, -4.7121643000e-3, & + 362.0, -4.2268163000, 2.7108756000e-3, -4.7038900000e-3, & + 363.0, -4.2312503000, 2.7060029000e-3, -4.6956653000e-3, & + 364.0, -4.2356795000, 2.7011692000e-3, -4.6874897000e-3, & + 365.0, -4.2401039000, 2.6963742000e-3, -4.6793627000e-3, & + 366.0, -4.2445234000, 2.6916175000e-3, -4.6712838000e-3, & + 367.0, -4.2489380000, 2.6868986000e-3, -4.6632526000e-3, & + 368.0, -4.2533476000, 2.6822172000e-3, -4.6552684000e-3, & + 369.0, -4.2577524000, 2.6775728000e-3, -4.6473310000e-3, & + 370.0, -4.2621522000, 2.6729652000e-3, -4.6394397000e-3, & + 371.0, -4.2665470000, 2.6683940000e-3, -4.6315942000e-3, & + 372.0, -4.2709369000, 2.6638587000e-3, -4.6237940000e-3, & + 373.0, -4.2753218000, 2.6593590000e-3, -4.6160387000e-3, & + 374.0, -4.2797016000, 2.6548946000e-3, -4.6083277000e-3, & + 375.0, -4.2840764000, 2.6504651000e-3, -4.6006607000e-3, & + 376.0, -4.2884462000, 2.6460701000e-3, -4.5930373000e-3, & + 377.0, -4.2928108000, 2.6417093000e-3, -4.5854569000e-3, & + 378.0, -4.2971704000, 2.6373823000e-3, -4.5779192000e-3, & + 379.0, -4.3015249000, 2.6330888000e-3, -4.5704238000e-3, & + 380.0, -4.3058742000, 2.6288285000e-3, -4.5629702000e-3, & + 381.0, -4.3102184000, 2.6246011000e-3, -4.5555581000e-3, & + 382.0, -4.3145575000, 2.6204061000e-3, -4.5481870000e-3, & + 383.0, -4.3188914000, 2.6162432000e-3, -4.5408565000e-3, & + 384.0, -4.3232200000, 2.6121122000e-3, -4.5335663000e-3, & + 385.0, -4.3275435000, 2.6080128000e-3, -4.5263159000e-3, & + 386.0, -4.3318617000, 2.6039445000e-3, -4.5191050000e-3, & + 387.0, -4.3361747000, 2.5999071000e-3, -4.5119331000e-3, & + 388.0, -4.3404824000, 2.5959002000e-3, -4.5048000000e-3, & + 389.0, -4.3447848000, 2.5919236000e-3, -4.4977052000e-3, & + 390.0, -4.3490820000, 2.5879770000e-3, -4.4906484000e-3, & + 391.0, -4.3533738000, 2.5840600000e-3, -4.4836292000e-3, & + 392.0, -4.3576603000, 2.5801724000e-3, -4.4766472000e-3, & + 393.0, -4.3619414000, 2.5763138000e-3, -4.4697021000e-3, & + 394.0, -4.3662172000, 2.5724840000e-3, -4.4627935000e-3, & + 395.0, -4.3704876000, 2.5686827000e-3, -4.4559212000e-3, & + 396.0, -4.3747527000, 2.5649095000e-3, -4.4490846000e-3, & + 397.0, -4.3790123000, 2.5611642000e-3, -4.4422836000e-3, & + 398.0, -4.3832665000, 2.5574466000e-3, -4.4355178000e-3, & + 399.0, -4.3875152000, 2.5537563000e-3, -4.4287868000e-3, & + 400.0, -4.3917586000, 2.5500930000e-3, -4.4220903000e-3, & + 401.0, -4.3959964000, 2.5464565000e-3, -4.4154280000e-3, & + 402.0, -4.4002288000, 2.5428466000e-3, -4.4087995000e-3, & + 403.0, -4.4044556000, 2.5392629000e-3, -4.4022046000e-3, & + 404.0, -4.4086770000, 2.5357051000e-3, -4.3956430000e-3, & + 405.0, -4.4128928000, 2.5321731000e-3, -4.3891142000e-3, & + 406.0, -4.4171031000, 2.5286666000e-3, -4.3826181000e-3, & + 407.0, -4.4213078000, 2.5251852000e-3, -4.3761543000e-3, & + 408.0, -4.4255070000, 2.5217289000e-3, -4.3697225000e-3, & + 409.0, -4.4297006000, 2.5182972000e-3, -4.3633224000e-3, & + 410.0, -4.4338886000, 2.5148899000e-3, -4.3569537000e-3, & + 411.0, -4.4380709000, 2.5115069000e-3, -4.3506162000e-3, & + 412.0, -4.4422477000, 2.5081478000e-3, -4.3443095000e-3, & + 413.0, -4.4464188000, 2.5048125000e-3, -4.3380334000e-3, & + 414.0, -4.4505843000, 2.5015006000e-3, -4.3317876000e-3, & + 415.0, -4.4547441000, 2.4982119000e-3, -4.3255718000e-3, & + 416.0, -4.4588982000, 2.4949463000e-3, -4.3193857000e-3, & + 417.0, -4.4630466000, 2.4917034000e-3, -4.3132290000e-3, & + 418.0, -4.4671894000, 2.4884831000e-3, -4.3071016000e-3, & + 419.0, -4.4713264000, 2.4852851000e-3, -4.3010031000e-3, & + 420.0, -4.4754577000, 2.4821092000e-3, -4.2949332000e-3, & + 421.0, -4.4795832000, 2.4789551000e-3, -4.2888918000e-3, & + 422.0, -4.4837030000, 2.4758227000e-3, -4.2828785000e-3, & + 423.0, -4.4878171000, 2.4727118000e-3, -4.2768931000e-3, & + 424.0, -4.4919253000, 2.4696220000e-3, -4.2709353000e-3, & + 425.0, -4.4960278000, 2.4665532000e-3, -4.2650050000e-3, & + 426.0, -4.5001245000, 2.4635053000e-3, -4.2591017000e-3, & + 427.0, -4.5042153000, 2.4604778000e-3, -4.2532254000e-3, & + 428.0, -4.5083003000, 2.4574708000e-3, -4.2473758000e-3, & + 429.0, -4.5123795000, 2.4544839000e-3, -4.2415526000e-3, & + 430.0, -4.5164529000, 2.4515170000e-3, -4.2357555000e-3, & + 431.0, -4.5205204000, 2.4485699000e-3, -4.2299844000e-3, & + 432.0, -4.5245820000, 2.4456423000e-3, -4.2242391000e-3, & + 433.0, -4.5286377000, 2.4427340000e-3, -4.2185193000e-3, & + 434.0, -4.5326876000, 2.4398450000e-3, -4.2128247000e-3, & + 435.0, -4.5367315000, 2.4369749000e-3, -4.2071552000e-3, & + 436.0, -4.5407695000, 2.4341235000e-3, -4.2015105000e-3, & + 437.0, -4.5448016000, 2.4312908000e-3, -4.1958904000e-3, & + 438.0, -4.5488278000, 2.4284765000e-3, -4.1902947000e-3, & + 439.0, -4.5528480000, 2.4256804000e-3, -4.1847233000e-3, & + 440.0, -4.5568623000, 2.4229023000e-3, -4.1791757000e-3, & + 441.0, -4.5608706000, 2.4201420000e-3, -4.1736520000e-3, & + 442.0, -4.5648729000, 2.4173995000e-3, -4.1681518000e-3, & + 443.0, -4.5688693000, 2.4146744000e-3, -4.1626750000e-3, & + 444.0, -4.5728596000, 2.4119666000e-3, -4.1572213000e-3, & + 445.0, -4.5768440000, 2.4092760000e-3, -4.1517905000e-3, & + 446.0, -4.5808223000, 2.4066023000e-3, -4.1463825000e-3, & + 447.0, -4.5847946000, 2.4039454000e-3, -4.1409971000e-3, & + 448.0, -4.5887608000, 2.4013051000e-3, -4.1356340000e-3, & + 449.0, -4.5927211000, 2.3986813000e-3, -4.1302931000e-3, & + 450.0, -4.5966752000, 2.3960738000e-3, -4.1249742000e-3, & + 451.0, -4.6006234000, 2.3934824000e-3, -4.1196771000e-3, & + 452.0, -4.6045654000, 2.3909070000e-3, -4.1144015000e-3, & + 453.0, -4.6085014000, 2.3883473000e-3, -4.1091474000e-3, & + 454.0, -4.6124313000, 2.3858033000e-3, -4.1039146000e-3, & + 455.0, -4.6163550000, 2.3832748000e-3, -4.0987028000e-3, & + 456.0, -4.6202727000, 2.3807615000e-3, -4.0935118000e-3, & + 457.0, -4.6241843000, 2.3782635000e-3, -4.0883416000e-3, & + 458.0, -4.6280897000, 2.3757804000e-3, -4.0831919000e-3, & + 459.0, -4.6319890000, 2.3733122000e-3, -4.0780626000e-3, & + 460.0, -4.6358822000, 2.3708588000e-3, -4.0729534000e-3, & + 461.0, -4.6397692000, 2.3684198000e-3, -4.0678643000e-3, & + 462.0, -4.6436501000, 2.3659953000e-3, -4.0627950000e-3, & + 463.0, -4.6475249000, 2.3635851000e-3, -4.0577454000e-3, & + 464.0, -4.6513934000, 2.3611889000e-3, -4.0527153000e-3, & + 465.0, -4.6552558000, 2.3588068000e-3, -4.0477046000e-3, & + 466.0, -4.6591120000, 2.3564384000e-3, -4.0427131000e-3, & + 467.0, -4.6629620000, 2.3540838000e-3, -4.0377406000e-3, & + 468.0, -4.6668058000, 2.3517427000e-3, -4.0327870000e-3, & + 469.0, -4.6706434000, 2.3494150000e-3, -4.0278521000e-3, & + 470.0, -4.6744748000, 2.3471006000e-3, -4.0229358000e-3, & + 471.0, -4.6783000000, 2.3447994000e-3, -4.0180379000e-3, & + 472.0, -4.6821189000, 2.3425111000e-3, -4.0131582000e-3, & + 473.0, -4.6859316000, 2.3402357000e-3, -4.0082967000e-3, & + 474.0, -4.6897381000, 2.3379731000e-3, -4.0034532000e-3, & + 475.0, -4.6935383000, 2.3357231000e-3, -3.9986274000e-3, & + 476.0, -4.6973323000, 2.3334855000e-3, -3.9938194000e-3, & + 477.0, -4.7011201000, 2.3312604000e-3, -3.9890289000e-3, & + 478.0, -4.7049015000, 2.3290474000e-3, -3.9842557000e-3, & + 479.0, -4.7086767000, 2.3268466000e-3, -3.9794999000e-3, & + 480.0, -4.7124456000, 2.3246577000e-3, -3.9747611000e-3, & + 481.0, -4.7162083000, 2.3224807000e-3, -3.9700393000e-3, & + 482.0, -4.7199646000, 2.3203154000e-3, -3.9653344000e-3, & + 483.0, -4.7237147000, 2.3181618000e-3, -3.9606461000e-3, & + 484.0, -4.7274585000, 2.3160196000e-3, -3.9559744000e-3, & + 485.0, -4.7311959000, 2.3138889000e-3, -3.9513192000e-3, & + 486.0, -4.7349271000, 2.3117694000e-3, -3.9466802000e-3, & + 487.0, -4.7386519000, 2.3096610000e-3, -3.9420575000e-3, & + 488.0, -4.7423704000, 2.3075637000e-3, -3.9374508000e-3, & + 489.0, -4.7460826000, 2.3054773000e-3, -3.9328600000e-3, & + 490.0, -4.7497885000, 2.3034017000e-3, -3.9282850000e-3, & + 491.0, -4.7534880000, 2.3013368000e-3, -3.9237256000e-3, & + 492.0, -4.7571812000, 2.2992825000e-3, -3.9191818000e-3, & + 493.0, -4.7608681000, 2.2972386000e-3, -3.9146535000e-3, & + 494.0, -4.7645486000, 2.2952052000e-3, -3.9101404000e-3, & + 495.0, -4.7682227000, 2.2931820000e-3, -3.9056425000e-3, & + 496.0, -4.7718905000, 2.2911690000e-3, -3.9011597000e-3, & + 497.0, -4.7755520000, 2.2891660000e-3, -3.8966919000e-3, & + 498.0, -4.7792071000, 2.2871729000e-3, -3.8922389000e-3, & + 499.0, -4.7828558000, 2.2851898000e-3, -3.8878005000e-3, & + 500.0, -4.7864981000, 2.2832163000e-3, -3.8833768000e-3, & + 501.0, -4.7901341000, 2.2812525000e-3, -3.8789676000e-3, & + 502.0, -4.7937636000, 2.2792983000e-3, -3.8745728000e-3, & + 503.0, -4.7973868000, 2.2773535000e-3, -3.8701922000e-3, & + 504.0, -4.8010036000, 2.2754180000e-3, -3.8658258000e-3, & + 505.0, -4.8046141000, 2.2734918000e-3, -3.8614735000e-3, & + 506.0, -4.8082181000, 2.2715748000e-3, -3.8571351000e-3, & + 507.0, -4.8118157000, 2.2696668000e-3, -3.8528105000e-3, & + 508.0, -4.8154069000, 2.2677678000e-3, -3.8484997000e-3, & + 509.0, -4.8189918000, 2.2658777000e-3, -3.8442025000e-3, & + 510.0, -4.8225702000, 2.2639964000e-3, -3.8399188000e-3, & + 511.0, -4.8261422000, 2.2621237000e-3, -3.8356485000e-3, & + 512.0, -4.8297078000, 2.2602597000e-3, -3.8313916000e-3, & + 513.0, -4.8332670000, 2.2584041000e-3, -3.8271479000e-3, & + 514.0, -4.8368197000, 2.2565570000e-3, -3.8229173000e-3, & + 515.0, -4.8403661000, 2.2547183000e-3, -3.8186997000e-3, & + 516.0, -4.8439060000, 2.2528877000e-3, -3.8144951000e-3, & + 517.0, -4.8474395000, 2.2510654000e-3, -3.8103033000e-3, & + 518.0, -4.8509666000, 2.2492511000e-3, -3.8061243000e-3, & + 519.0, -4.8544872000, 2.2474448000e-3, -3.8019578000e-3, & + 520.0, -4.8580014000, 2.2456465000e-3, -3.7978040000e-3, & + 521.0, -4.8615092000, 2.2438560000e-3, -3.7936626000e-3, & + 522.0, -4.8650105000, 2.2420732000e-3, -3.7895335000e-3, & + 523.0, -4.8685054000, 2.2402981000e-3, -3.7854168000e-3, & + 524.0, -4.8719939000, 2.2385305000e-3, -3.7813122000e-3, & + 525.0, -4.8754759000, 2.2367705000e-3, -3.7772197000e-3, & + 526.0, -4.8789515000, 2.2350179000e-3, -3.7731392000e-3, & + 527.0, -4.8824206000, 2.2332727000e-3, -3.7690706000e-3, & + 528.0, -4.8858833000, 2.2315347000e-3, -3.7650139000e-3, & + 529.0, -4.8893395000, 2.2298040000e-3, -3.7609689000e-3, & + 530.0, -4.8927893000, 2.2280804000e-3, -3.7569356000e-3, & + 531.0, -4.8962327000, 2.2263638000e-3, -3.7529139000e-3, & + 532.0, -4.8996696000, 2.2246542000e-3, -3.7489037000e-3, & + 533.0, -4.9031000000, 2.2229515000e-3, -3.7449049000e-3, & + 534.0, -4.9065240000, 2.2212556000e-3, -3.7409174000e-3, & + 535.0, -4.9099415000, 2.2195665000e-3, -3.7369411000e-3, & + 536.0, -4.9133526000, 2.2178841000e-3, -3.7329761000e-3, & + 537.0, -4.9167573000, 2.2162082000e-3, -3.7290221000e-3, & + 538.0, -4.9201554000, 2.2145390000e-3, -3.7250792000e-3, & + 539.0, -4.9235472000, 2.2128762000e-3, -3.7211471000e-3, & + 540.0, -4.9269324000, 2.2112198000e-3, -3.7172260000e-3, & + 541.0, -4.9303112000, 2.2095698000e-3, -3.7133156000e-3, & + 542.0, -4.9336836000, 2.2079261000e-3, -3.7094160000e-3, & + 543.0, -4.9370495000, 2.2062885000e-3, -3.7055269000e-3, & + 544.0, -4.9404089000, 2.2046571000e-3, -3.7016485000e-3, & + 545.0, -4.9437619000, 2.2030318000e-3, -3.6977805000e-3, & + 546.0, -4.9471084000, 2.2014125000e-3, -3.6939229000e-3, & + 547.0, -4.9504485000, 2.1997991000e-3, -3.6900757000e-3, & + 548.0, -4.9537821000, 2.1981917000e-3, -3.6862387000e-3, & + 549.0, -4.9571092000, 2.1965901000e-3, -3.6824120000e-3, & + 550.0, -4.9604299000, 2.1949942000e-3, -3.6785954000e-3, & + 551.0, -4.9637442000, 2.1934040000e-3, -3.6747888000e-3, & + 552.0, -4.9670519000, 2.1918195000e-3, -3.6709922000e-3, & + 553.0, -4.9703533000, 2.1902406000e-3, -3.6672056000e-3, & + 554.0, -4.9736481000, 2.1886671000e-3, -3.6634288000e-3, & + 555.0, -4.9769366000, 2.1870992000e-3, -3.6596618000e-3, & + 556.0, -4.9802185000, 2.1855366000e-3, -3.6559045000e-3, & + 557.0, -4.9834940000, 2.1839795000e-3, -3.6521569000e-3, & + 558.0, -4.9867631000, 2.1824276000e-3, -3.6484189000e-3, & + 559.0, -4.9900257000, 2.1808809000e-3, -3.6446904000e-3, & + 560.0, -4.9932819000, 2.1793394000e-3, -3.6409714000e-3, & + 561.0, -4.9965316000, 2.1778031000e-3, -3.6372617000e-3, & + 562.0, -4.9997749000, 2.1762718000e-3, -3.6335615000e-3, & + 563.0, -5.0030117000, 2.1747455000e-3, -3.6298704000e-3, & + 564.0, -5.0062421000, 2.1732242000e-3, -3.6261887000e-3, & + 565.0, -5.0094660000, 2.1717078000e-3, -3.6225160000e-3, & + 566.0, -5.0126835000, 2.1701963000e-3, -3.6188525000e-3, & + 567.0, -5.0158946000, 2.1686895000e-3, -3.6151980000e-3, & + 568.0, -5.0190992000, 2.1671876000e-3, -3.6115525000e-3, & + 569.0, -5.0222974000, 2.1656903000e-3, -3.6079159000e-3, & + 570.0, -5.0254891000, 2.1641977000e-3, -3.6042882000e-3, & + 571.0, -5.0286744000, 2.1627096000e-3, -3.6006692000e-3, & + 572.0, -5.0318533000, 2.1612262000e-3, -3.5970590000e-3, & + 573.0, -5.0350258000, 2.1597472000e-3, -3.5934575000e-3, & + 574.0, -5.0381918000, 2.1582727000e-3, -3.5898647000e-3, & + 575.0, -5.0413514000, 2.1568026000e-3, -3.5862804000e-3, & + 576.0, -5.0445046000, 2.1553369000e-3, -3.5827047000e-3, & + 577.0, -5.0476514000, 2.1538755000e-3, -3.5791374000e-3, & + 578.0, -5.0507917000, 2.1524183000e-3, -3.5755785000e-3, & + 579.0, -5.0539256000, 2.1509654000e-3, -3.5720280000e-3, & + 580.0, -5.0570532000, 2.1495166000e-3, -3.5684858000e-3, & + 581.0, -5.0601743000, 2.1480720000e-3, -3.5649519000e-3, & + 582.0, -5.0632890000, 2.1466315000e-3, -3.5614262000e-3, & + 583.0, -5.0663973000, 2.1451950000e-3, -3.5579086000e-3, & + 584.0, -5.0694991000, 2.1437625000e-3, -3.5543992000e-3, & + 585.0, -5.0725946000, 2.1423339000e-3, -3.5508978000e-3, & + 586.0, -5.0756837000, 2.1409093000e-3, -3.5474044000e-3, & + 587.0, -5.0787664000, 2.1394885000e-3, -3.5439189000e-3, & + 588.0, -5.0818427000, 2.1380716000e-3, -3.5404414000e-3, & + 589.0, -5.0849126000, 2.1366585000e-3, -3.5369717000e-3, & + 590.0, -5.0879762000, 2.1352491000e-3, -3.5335099000e-3, & + 591.0, -5.0910333000, 2.1338434000e-3, -3.5300557000e-3, & + 592.0, -5.0940841000, 2.1324413000e-3, -3.5266094000e-3, & + 593.0, -5.0971285000, 2.1310429000e-3, -3.5231706000e-3, & + 594.0, -5.1001665000, 2.1296481000e-3, -3.5197395000e-3, & + 595.0, -5.1031982000, 2.1282569000e-3, -3.5163160000e-3, & + 596.0, -5.1062234000, 2.1268691000e-3, -3.5129000000e-3, & + 597.0, -5.1092424000, 2.1254848000e-3, -3.5094915000e-3, & + 598.0, -5.1122549000, 2.1241039000e-3, -3.5060904000e-3, & + 599.0, -5.1152611000, 2.1227265000e-3, -3.5026968000e-3, & + 600.0, -5.1182610000, 2.1213524000e-3, -3.4993105000e-3, & + 601.0, -5.1212545000, 2.1199816000e-3, -3.4959315000e-3, & + 602.0, -5.1242417000, 2.1186141000e-3, -3.4925597000e-3, & + 603.0, -5.1272225000, 2.1172498000e-3, -3.4891952000e-3, & + 604.0, -5.1301970000, 2.1158888000e-3, -3.4858379000e-3, & + 605.0, -5.1331651000, 2.1145309000e-3, -3.4824877000e-3, & + 606.0, -5.1361270000, 2.1131762000e-3, -3.4791445000e-3, & + 607.0, -5.1390825000, 2.1118246000e-3, -3.4758085000e-3, & + 608.0, -5.1420316000, 2.1104761000e-3, -3.4724795000e-3, & + 609.0, -5.1449745000, 2.1091306000e-3, -3.4691574000e-3, & + 610.0, -5.1479111000, 2.1077881000e-3, -3.4658423000e-3, & + 611.0, -5.1508413000, 2.1064486000e-3, -3.4625341000e-3, & + 612.0, -5.1537652000, 2.1051120000e-3, -3.4592327000e-3, & + 613.0, -5.1566829000, 2.1037784000e-3, -3.4559381000e-3, & + 614.0, -5.1595942000, 2.1024476000e-3, -3.4526504000e-3, & + 615.0, -5.1624993000, 2.1011196000e-3, -3.4493693000e-3, & + 616.0, -5.1653981000, 2.0997945000e-3, -3.4460950000e-3, & + 617.0, -5.1682905000, 2.0984722000e-3, -3.4428273000e-3, & + 618.0, -5.1711768000, 2.0971526000e-3, -3.4395663000e-3, & + 619.0, -5.1740567000, 2.0958358000e-3, -3.4363118000e-3, & + 620.0, -5.1769304000, 2.0945216000e-3, -3.4330639000e-3, & + 621.0, -5.1797978000, 2.0932101000e-3, -3.4298226000e-3, & + 622.0, -5.1826589000, 2.0919012000e-3, -3.4265877000e-3, & + 623.0, -5.1855138000, 2.0905950000e-3, -3.4233592000e-3, & + 624.0, -5.1883625000, 2.0892913000e-3, -3.4201372000e-3, & + 625.0, -5.1912049000, 2.0879902000e-3, -3.4169215000e-3, & + 626.0, -5.1940410000, 2.0866915000e-3, -3.4137122000e-3, & + 627.0, -5.1968710000, 2.0853954000e-3, -3.4105092000e-3, & + 628.0, -5.1996947000, 2.0841018000e-3, -3.4073124000e-3, & + 629.0, -5.2025121000, 2.0828105000e-3, -3.4041219000e-3, & + 630.0, -5.2053234000, 2.0815217000e-3, -3.4009376000e-3, & + 631.0, -5.2081285000, 2.0802353000e-3, -3.3977595000e-3, & + 632.0, -5.2109273000, 2.0789512000e-3, -3.3945875000e-3, & + 633.0, -5.2137199000, 2.0776695000e-3, -3.3914216000e-3, & + 634.0, -5.2165064000, 2.0763900000e-3, -3.3882618000e-3, & + 635.0, -5.2192866000, 2.0751129000e-3, -3.3851080000e-3, & + 636.0, -5.2220607000, 2.0738380000e-3, -3.3819602000e-3, & + 637.0, -5.2248286000, 2.0725653000e-3, -3.3788184000e-3, & + 638.0, -5.2275903000, 2.0712949000e-3, -3.3756826000e-3, & + 639.0, -5.2303458000, 2.0700266000e-3, -3.3725527000e-3, & + 640.0, -5.2330952000, 2.0687604000e-3, -3.3694286000e-3, & + 641.0, -5.2358384000, 2.0674964000e-3, -3.3663104000e-3, & + 642.0, -5.2385755000, 2.0662346000e-3, -3.3631981000e-3, & + 643.0, -5.2413064000, 2.0649747000e-3, -3.3600915000e-3, & + 644.0, -5.2440312000, 2.0637170000e-3, -3.3569907000e-3, & + 645.0, -5.2467498000, 2.0624613000e-3, -3.3538957000e-3, & + 646.0, -5.2494624000, 2.0612076000e-3, -3.3508063000e-3, & + 647.0, -5.2521688000, 2.0599559000e-3, -3.3477227000e-3, & + 648.0, -5.2548690000, 2.0587062000e-3, -3.3446446000e-3, & + 649.0, -5.2575632000, 2.0574585000e-3, -3.3415722000e-3, & + 650.0, -5.2602513000, 2.0562126000e-3, -3.3385054000e-3, & + 651.0, -5.2629332000, 2.0549687000e-3, -3.3354442000e-3, & + 652.0, -5.2656091000, 2.0537266000e-3, -3.3323885000e-3, & + 653.0, -5.2682789000, 2.0524865000e-3, -3.3293383000e-3, & + 654.0, -5.2709426000, 2.0512481000e-3, -3.3262936000e-3, & + 655.0, -5.2736002000, 2.0500116000e-3, -3.3232543000e-3, & + 656.0, -5.2762518000, 2.0487769000e-3, -3.3202205000e-3, & + 657.0, -5.2788973000, 2.0475440000e-3, -3.3171921000e-3, & + 658.0, -5.2815367000, 2.0463128000e-3, -3.3141691000e-3, & + 659.0, -5.2841701000, 2.0450834000e-3, -3.3111514000e-3, & + 660.0, -5.2867975000, 2.0438557000e-3, -3.3081390000e-3, & + 661.0, -5.2894188000, 2.0426297000e-3, -3.3051319000e-3, & + 662.0, -5.2920341000, 2.0414054000e-3, -3.3021302000e-3, & + 663.0, -5.2946433000, 2.0401828000e-3, -3.2991336000e-3, & + 664.0, -5.2972466000, 2.0389618000e-3, -3.2961423000e-3, & + 665.0, -5.2998438000, 2.0377425000e-3, -3.2931562000e-3, & + 666.0, -5.3024350000, 2.0365247000e-3, -3.2901753000e-3, & + 667.0, -5.3050203000, 2.0353086000e-3, -3.2871995000e-3, & + 668.0, -5.3075995000, 2.0340940000e-3, -3.2842288000e-3, & + 669.0, -5.3101728000, 2.0328810000e-3, -3.2812633000e-3, & + 670.0, -5.3127401000, 2.0316695000e-3, -3.2783028000e-3, & + 671.0, -5.3153014000, 2.0304596000e-3, -3.2753474000e-3, & + 672.0, -5.3178568000, 2.0292512000e-3, -3.2723970000e-3, & + 673.0, -5.3204062000, 2.0280443000e-3, -3.2694517000e-3, & + 674.0, -5.3229496000, 2.0268388000e-3, -3.2665113000e-3, & + 675.0, -5.3254871000, 2.0256348000e-3, -3.2635759000e-3, & + 676.0, -5.3280187000, 2.0244322000e-3, -3.2606454000e-3, & + 677.0, -5.3305444000, 2.0232311000e-3, -3.2577199000e-3, & + 678.0, -5.3330641000, 2.0220314000e-3, -3.2547992000e-3, & + 679.0, -5.3355779000, 2.0208331000e-3, -3.2518834000e-3, & + 680.0, -5.3380858000, 2.0196361000e-3, -3.2489725000e-3, & + 681.0, -5.3405878000, 2.0184406000e-3, -3.2460664000e-3, & + 682.0, -5.3430840000, 2.0172463000e-3, -3.2431652000e-3, & + 683.0, -5.3455742000, 2.0160534000e-3, -3.2402687000e-3, & + 684.0, -5.3480585000, 2.0148619000e-3, -3.2373770000e-3, & + 685.0, -5.3505370000, 2.0136716000e-3, -3.2344900000e-3, & + 686.0, -5.3530097000, 2.0124826000e-3, -3.2316078000e-3, & + 687.0, -5.3554764000, 2.0112949000e-3, -3.2287303000e-3, & + 688.0, -5.3579373000, 2.0101085000e-3, -3.2258574000e-3, & + 689.0, -5.3603924000, 2.0089233000e-3, -3.2229893000e-3, & + 690.0, -5.3628417000, 2.0077394000e-3, -3.2201258000e-3, & + 691.0, -5.3652851000, 2.0065567000e-3, -3.2172669000e-3, & + 692.0, -5.3677227000, 2.0053752000e-3, -3.2144126000e-3, & + 693.0, -5.3701545000, 2.0041948000e-3, -3.2115629000e-3, & + 694.0, -5.3725805000, 2.0030157000e-3, -3.2087178000e-3, & + 695.0, -5.3750006000, 2.0018377000e-3, -3.2058772000e-3, & + 696.0, -5.3774150000, 2.0006609000e-3, -3.2030412000e-3, & + 697.0, -5.3798237000, 1.9994853000e-3, -3.2002097000e-3, & + 698.0, -5.3822265000, 1.9983108000e-3, -3.1973826000e-3, & + 699.0, -5.3846236000, 1.9971373000e-3, -3.1945601000e-3, & + 700.0, -5.3870149000, 1.9959650000e-3, -3.1917420000e-3, & + 701.0, -5.3894005000, 1.9947938000e-3, -3.1889283000e-3, & + 702.0, -5.3917803000, 1.9936237000e-3, -3.1861191000e-3, & + 703.0, -5.3941544000, 1.9924547000e-3, -3.1833143000e-3, & + 704.0, -5.3965228000, 1.9912867000e-3, -3.1805139000e-3, & + 705.0, -5.3988854000, 1.9901198000e-3, -3.1777178000e-3, & + 706.0, -5.4012423000, 1.9889539000e-3, -3.1749261000e-3, & + 707.0, -5.4035936000, 1.9877890000e-3, -3.1721387000e-3, & + 708.0, -5.4059391000, 1.9866252000e-3, -3.1693556000e-3, & + 709.0, -5.4082790000, 1.9854623000e-3, -3.1665769000e-3, & + 710.0, -5.4106131000, 1.9843005000e-3, -3.1638024000e-3, & + 711.0, -5.4129416000, 1.9831396000e-3, -3.1610322000e-3, & + 712.0, -5.4152645000, 1.9819797000e-3, -3.1582662000e-3, & + 713.0, -5.4175816000, 1.9808208000e-3, -3.1555045000e-3, & + 714.0, -5.4198932000, 1.9796628000e-3, -3.1527469000e-3, & + 715.0, -5.4221991000, 1.9785058000e-3, -3.1499936000e-3, & + 716.0, -5.4244993000, 1.9773497000e-3, -3.1472445000e-3, & + 717.0, -5.4267939000, 1.9761945000e-3, -3.1444995000e-3, & + 718.0, -5.4290830000, 1.9750402000e-3, -3.1417587000e-3, & + 719.0, -5.4313664000, 1.9738869000e-3, -3.1390221000e-3, & + 720.0, -5.4336442000, 1.9727344000e-3, -3.1362895000e-3, & + 721.0, -5.4359164000, 1.9715828000e-3, -3.1335611000e-3, & + 722.0, -5.4381830000, 1.9704321000e-3, -3.1308367000e-3, & + 723.0, -5.4404441000, 1.9692823000e-3, -3.1281164000e-3, & + 724.0, -5.4426996000, 1.9681333000e-3, -3.1254002000e-3, & + 725.0, -5.4449495000, 1.9669852000e-3, -3.1226881000e-3, & + 726.0, -5.4471939000, 1.9658379000e-3, -3.1199799000e-3, & + 727.0, -5.4494328000, 1.9646915000e-3, -3.1172758000e-3, & + 728.0, -5.4516661000, 1.9635458000e-3, -3.1145757000e-3, & + 729.0, -5.4538938000, 1.9624010000e-3, -3.1118796000e-3, & + 730.0, -5.4561161000, 1.9612570000e-3, -3.1091874000e-3, & + 731.0, -5.4583329000, 1.9601138000e-3, -3.1064992000e-3, & + 732.0, -5.4605441000, 1.9589714000e-3, -3.1038149000e-3, & + 733.0, -5.4627499000, 1.9578298000e-3, -3.1011346000e-3, & + 734.0, -5.4649502000, 1.9566889000e-3, -3.0984582000e-3, & + 735.0, -5.4671450000, 1.9555488000e-3, -3.0957857000e-3, & + 736.0, -5.4693343000, 1.9544095000e-3, -3.0931171000e-3, & + 737.0, -5.4715182000, 1.9532709000e-3, -3.0904524000e-3, & + 738.0, -5.4736966000, 1.9521331000e-3, -3.0877915000e-3, & + 739.0, -5.4758696000, 1.9509960000e-3, -3.0851345000e-3, & + 740.0, -5.4780372000, 1.9498596000e-3, -3.0824813000e-3, & + 741.0, -5.4801993000, 1.9487240000e-3, -3.0798319000e-3, & + 742.0, -5.4823560000, 1.9475891000e-3, -3.0771864000e-3, & + 743.0, -5.4845073000, 1.9464549000e-3, -3.0745446000e-3, & + 744.0, -5.4866533000, 1.9453214000e-3, -3.0719066000e-3, & + 745.0, -5.4887938000, 1.9441885000e-3, -3.0692724000e-3, & + 746.0, -5.4909289000, 1.9430564000e-3, -3.0666420000e-3, & + 747.0, -5.4930587000, 1.9419250000e-3, -3.0640153000e-3, & + 748.0, -5.4951831000, 1.9407942000e-3, -3.0613923000e-3, & + 749.0, -5.4973021000, 1.9396641000e-3, -3.0587731000e-3, & + 750.0, -5.4994158000, 1.9385347000e-3, -3.0561575000e-3, & + 751.0, -5.5015242000, 1.9374059000e-3, -3.0535457000e-3, & + 752.0, -5.5036272000, 1.9362778000e-3, -3.0509375000e-3, & + 753.0, -5.5057250000, 1.9351503000e-3, -3.0483331000e-3, & + 754.0, -5.5078174000, 1.9340235000e-3, -3.0457322000e-3, & + 755.0, -5.5099044000, 1.9328973000e-3, -3.0431351000e-3, & + 756.0, -5.5119863000, 1.9317717000e-3, -3.0405415000e-3, & + 757.0, -5.5140628000, 1.9306468000e-3, -3.0379516000e-3, & + 758.0, -5.5161340000, 1.9295224000e-3, -3.0353653000e-3, & + 759.0, -5.5182000000, 1.9283987000e-3, -3.0327826000e-3, & + 760.0, -5.5202607000, 1.9272756000e-3, -3.0302035000e-3, & + 761.0, -5.5223161000, 1.9261531000e-3, -3.0276280000e-3, & + 762.0, -5.5243664000, 1.9250311000e-3, -3.0250561000e-3, & + 763.0, -5.5264113000, 1.9239098000e-3, -3.0224877000e-3, & + 764.0, -5.5284511000, 1.9227890000e-3, -3.0199228000e-3, & + 765.0, -5.5304856000, 1.9216689000e-3, -3.0173615000e-3, & + 766.0, -5.5325150000, 1.9205493000e-3, -3.0148038000e-3, & + 767.0, -5.5345391000, 1.9194303000e-3, -3.0122495000e-3, & + 768.0, -5.5365581000, 1.9183118000e-3, -3.0096987000e-3, & + 769.0, -5.5385718000, 1.9171939000e-3, -3.0071515000e-3, & + 770.0, -5.5405804000, 1.9160766000e-3, -3.0046077000e-3, & + 771.0, -5.5425839000, 1.9149598000e-3, -3.0020674000e-3, & + 772.0, -5.5445822000, 1.9138435000e-3, -2.9995305000e-3, & + 773.0, -5.5465753000, 1.9127278000e-3, -2.9969971000e-3, & + 774.0, -5.5485633000, 1.9116127000e-3, -2.9944671000e-3, & + 775.0, -5.5505462000, 1.9104981000e-3, -2.9919406000e-3, & + 776.0, -5.5525239000, 1.9093840000e-3, -2.9894175000e-3, & + 777.0, -5.5544966000, 1.9082704000e-3, -2.9868978000e-3, & + 778.0, -5.5564641000, 1.9071573000e-3, -2.9843815000e-3, & + 779.0, -5.5584266000, 1.9060448000e-3, -2.9818686000e-3, & + 780.0, -5.5603840000, 1.9049328000e-3, -2.9793591000e-3, & + 781.0, -5.5623363000, 1.9038213000e-3, -2.9768530000e-3, & + 782.0, -5.5642835000, 1.9027103000e-3, -2.9743502000e-3, & + 783.0, -5.5662257000, 1.9015998000e-3, -2.9718507000e-3, & + 784.0, -5.5681628000, 1.9004898000e-3, -2.9693547000e-3, & + 785.0, -5.5700949000, 1.8993803000e-3, -2.9668619000e-3, & + 786.0, -5.5720220000, 1.8982713000e-3, -2.9643725000e-3, & + 787.0, -5.5739440000, 1.8971627000e-3, -2.9618864000e-3, & + 788.0, -5.5758611000, 1.8960547000e-3, -2.9594036000e-3, & + 789.0, -5.5777731000, 1.8949471000e-3, -2.9569240000e-3, & + 790.0, -5.5796802000, 1.8938401000e-3, -2.9544478000e-3, & + 791.0, -5.5815822000, 1.8927334000e-3, -2.9519749000e-3, & + 792.0, -5.5834793000, 1.8916273000e-3, -2.9495052000e-3, & + 793.0, -5.5853715000, 1.8905216000e-3, -2.9470388000e-3, & + 794.0, -5.5872586000, 1.8894164000e-3, -2.9445756000e-3, & + 795.0, -5.5891409000, 1.8883117000e-3, -2.9421157000e-3, & + 796.0, -5.5910182000, 1.8872074000e-3, -2.9396591000e-3, & + 797.0, -5.5928905000, 1.8861036000e-3, -2.9372056000e-3, & + 798.0, -5.5947580000, 1.8850002000e-3, -2.9347554000e-3, & + 799.0, -5.5966205000, 1.8838973000e-3, -2.9323083000e-3, & + 800.0, -5.5984781000, 1.8827948000e-3, -2.9298645000e-3, & + 801.0, -5.6003309000, 1.8816928000e-3, -2.9274239000e-3, & + 802.0, -5.6021787000, 1.8805912000e-3, -2.9249864000e-3, & + 803.0, -5.6040217000, 1.8794901000e-3, -2.9225522000e-3, & + 804.0, -5.6058598000, 1.8783894000e-3, -2.9201211000e-3, & + 805.0, -5.6076931000, 1.8772891000e-3, -2.9176931000e-3, & + 806.0, -5.6095215000, 1.8761892000e-3, -2.9152683000e-3, & + 807.0, -5.6113451000, 1.8750898000e-3, -2.9128467000e-3, & + 808.0, -5.6131638000, 1.8739909000e-3, -2.9104282000e-3, & + 809.0, -5.6149777000, 1.8728923000e-3, -2.9080128000e-3, & + 810.0, -5.6167869000, 1.8717942000e-3, -2.9056005000e-3, & + 811.0, -5.6185912000, 1.8706965000e-3, -2.9031914000e-3, & + 812.0, -5.6203907000, 1.8695992000e-3, -2.9007853000e-3, & + 813.0, -5.6221855000, 1.8685023000e-3, -2.8983824000e-3, & + 814.0, -5.6239754000, 1.8674058000e-3, -2.8959825000e-3, & + 815.0, -5.6257606000, 1.8663098000e-3, -2.8935857000e-3, & + 816.0, -5.6275411000, 1.8652141000e-3, -2.8911920000e-3, & + 817.0, -5.6293168000, 1.8641189000e-3, -2.8888014000e-3, & + 818.0, -5.6310878000, 1.8630241000e-3, -2.8864138000e-3, & + 819.0, -5.6328540000, 1.8619297000e-3, -2.8840292000e-3, & + 820.0, -5.6346155000, 1.8608357000e-3, -2.8816477000e-3, & + 821.0, -5.6363723000, 1.8597420000e-3, -2.8792693000e-3, & + 822.0, -5.6381245000, 1.8586488000e-3, -2.8768939000e-3, & + 823.0, -5.6398719000, 1.8575560000e-3, -2.8745215000e-3, & + 824.0, -5.6416146000, 1.8564636000e-3, -2.8721521000e-3, & + 825.0, -5.6433527000, 1.8553716000e-3, -2.8697857000e-3, & + 826.0, -5.6450861000, 1.8542799000e-3, -2.8674223000e-3, & + 827.0, -5.6468149000, 1.8531887000e-3, -2.8650619000e-3, & + 828.0, -5.6485390000, 1.8520979000e-3, -2.8627045000e-3, & + 829.0, -5.6502584000, 1.8510074000e-3, -2.8603501000e-3, & + 830.0, -5.6519733000, 1.8499173000e-3, -2.8579986000e-3, & + 831.0, -5.6536835000, 1.8488276000e-3, -2.8556502000e-3, & + 832.0, -5.6553891000, 1.8477384000e-3, -2.8533046000e-3, & + 833.0, -5.6570901000, 1.8466494000e-3, -2.8509621000e-3, & + 834.0, -5.6587866000, 1.8455609000e-3, -2.8486224000e-3, & + 835.0, -5.6604784000, 1.8444728000e-3, -2.8462858000e-3, & + 836.0, -5.6621657000, 1.8433850000e-3, -2.8439520000e-3, & + 837.0, -5.6638484000, 1.8422976000e-3, -2.8416212000e-3, & + 838.0, -5.6655266000, 1.8412106000e-3, -2.8392933000e-3, & + 839.0, -5.6672002000, 1.8401239000e-3, -2.8369683000e-3, & + 840.0, -5.6688693000, 1.8390377000e-3, -2.8346462000e-3, & + 841.0, -5.6705338000, 1.8379518000e-3, -2.8323270000e-3, & + 842.0, -5.6721939000, 1.8368663000e-3, -2.8300107000e-3, & + 843.0, -5.6738494000, 1.8357811000e-3, -2.8276973000e-3, & + 844.0, -5.6755004000, 1.8346964000e-3, -2.8253867000e-3, & + 845.0, -5.6771470000, 1.8336120000e-3, -2.8230791000e-3, & + 846.0, -5.6787890000, 1.8325279000e-3, -2.8207743000e-3, & + 847.0, -5.6804266000, 1.8314443000e-3, -2.8184724000e-3, & + 848.0, -5.6820597000, 1.8303610000e-3, -2.8161733000e-3, & + 849.0, -5.6836884000, 1.8292781000e-3, -2.8138771000e-3, & + 850.0, -5.6853127000, 1.8281955000e-3, -2.8115837000e-3, & + 851.0, -5.6869325000, 1.8271133000e-3, -2.8092932000e-3, & + 852.0, -5.6885478000, 1.8260315000e-3, -2.8070055000e-3, & + 853.0, -5.6901588000, 1.8249501000e-3, -2.8047206000e-3, & + 854.0, -5.6917653000, 1.8238690000e-3, -2.8024385000e-3, & + 855.0, -5.6933675000, 1.8227882000e-3, -2.8001593000e-3, & + 856.0, -5.6949653000, 1.8217079000e-3, -2.7978829000e-3, & + 857.0, -5.6965586000, 1.8206279000e-3, -2.7956092000e-3, & + 858.0, -5.6981477000, 1.8195482000e-3, -2.7933384000e-3, & + 859.0, -5.6997323000, 1.8184690000e-3, -2.7910703000e-3, & + 860.0, -5.7013126000, 1.8173900000e-3, -2.7888051000e-3, & + 861.0, -5.7028886000, 1.8163115000e-3, -2.7865426000e-3, & + 862.0, -5.7044602000, 1.8152333000e-3, -2.7842829000e-3, & + 863.0, -5.7060275000, 1.8141555000e-3, -2.7820260000e-3, & + 864.0, -5.7075905000, 1.8130780000e-3, -2.7797718000e-3, & + 865.0, -5.7091492000, 1.8120009000e-3, -2.7775204000e-3, & + 866.0, -5.7107035000, 1.8109241000e-3, -2.7752717000e-3, & + 867.0, -5.7122536000, 1.8098477000e-3, -2.7730258000e-3, & + 868.0, -5.7137995000, 1.8087717000e-3, -2.7707826000e-3, & + 869.0, -5.7153410000, 1.8076960000e-3, -2.7685421000e-3, & + 870.0, -5.7168783000, 1.8066207000e-3, -2.7663044000e-3, & + 871.0, -5.7184113000, 1.8055458000e-3, -2.7640694000e-3, & + 872.0, -5.7199401000, 1.8044712000e-3, -2.7618372000e-3, & + 873.0, -5.7214646000, 1.8033969000e-3, -2.7596076000e-3, & + 874.0, -5.7229850000, 1.8023230000e-3, -2.7573808000e-3, & + 875.0, -5.7245011000, 1.8012495000e-3, -2.7551566000e-3, & + 876.0, -5.7260130000, 1.8001763000e-3, -2.7529352000e-3, & + 877.0, -5.7275207000, 1.7991035000e-3, -2.7507164000e-3, & + 878.0, -5.7290242000, 1.7980311000e-3, -2.7485003000e-3, & + 879.0, -5.7305236000, 1.7969590000e-3, -2.7462870000e-3, & + 880.0, -5.7320187000, 1.7958873000e-3, -2.7440763000e-3, & + 881.0, -5.7335097000, 1.7948159000e-3, -2.7418682000e-3, & + 882.0, -5.7349966000, 1.7937449000e-3, -2.7396629000e-3, & + 883.0, -5.7364793000, 1.7926742000e-3, -2.7374601000e-3, & + 884.0, -5.7379579000, 1.7916039000e-3, -2.7352601000e-3, & + 885.0, -5.7394323000, 1.7905340000e-3, -2.7330627000e-3, & + 886.0, -5.7409027000, 1.7894644000e-3, -2.7308680000e-3, & + 887.0, -5.7423689000, 1.7883951000e-3, -2.7286759000e-3, & + 888.0, -5.7438310000, 1.7873263000e-3, -2.7264864000e-3, & + 889.0, -5.7452891000, 1.7862578000e-3, -2.7242996000e-3, & + 890.0, -5.7467430000, 1.7851896000e-3, -2.7221154000e-3, & + 891.0, -5.7481929000, 1.7841218000e-3, -2.7199338000e-3, & + 892.0, -5.7496387000, 1.7830544000e-3, -2.7177548000e-3, & + 893.0, -5.7510805000, 1.7819873000e-3, -2.7155785000e-3, & + 894.0, -5.7525182000, 1.7809206000e-3, -2.7134047000e-3, & + 895.0, -5.7539519000, 1.7798543000e-3, -2.7112336000e-3, & + 896.0, -5.7553816000, 1.7787883000e-3, -2.7090651000e-3, & + 897.0, -5.7568072000, 1.7777227000e-3, -2.7068991000e-3, & + 898.0, -5.7582289000, 1.7766574000e-3, -2.7047358000e-3, & + 899.0, -5.7596465000, 1.7755925000e-3, -2.7025750000e-3, & + 900.0, -5.7610602000, 1.7745280000e-3, -2.7004169000e-3, & + 901.0, -5.7624698000, 1.7734638000e-3, -2.6982613000e-3, & + 902.0, -5.7638755000, 1.7724000000e-3, -2.6961082000e-3, & + 903.0, -5.7652772000, 1.7713365000e-3, -2.6939578000e-3, & + 904.0, -5.7666750000, 1.7702734000e-3, -2.6918099000e-3, & + 905.0, -5.7680688000, 1.7692107000e-3, -2.6896645000e-3, & + 906.0, -5.7694587000, 1.7681484000e-3, -2.6875218000e-3, & + 907.0, -5.7708447000, 1.7670864000e-3, -2.6853815000e-3, & + 908.0, -5.7722267000, 1.7660247000e-3, -2.6832438000e-3, & + 909.0, -5.7736048000, 1.7649635000e-3, -2.6811087000e-3, & + 910.0, -5.7749791000, 1.7639026000e-3, -2.6789761000e-3, & + 911.0, -5.7763494000, 1.7628421000e-3, -2.6768460000e-3, & + 912.0, -5.7777158000, 1.7617819000e-3, -2.6747185000e-3, & + 913.0, -5.7790784000, 1.7607221000e-3, -2.6725934000e-3, & + 914.0, -5.7804371000, 1.7596627000e-3, -2.6704709000e-3, & + 915.0, -5.7817919000, 1.7586037000e-3, -2.6683510000e-3, & + 916.0, -5.7831429000, 1.7575450000e-3, -2.6662335000e-3, & + 917.0, -5.7844901000, 1.7564867000e-3, -2.6641185000e-3, & + 918.0, -5.7858334000, 1.7554288000e-3, -2.6620060000e-3, & + 919.0, -5.7871729000, 1.7543712000e-3, -2.6598961000e-3, & + 920.0, -5.7885086000, 1.7533140000e-3, -2.6577886000e-3, & + 921.0, -5.7898405000, 1.7522572000e-3, -2.6556836000e-3, & + 922.0, -5.7911686000, 1.7512008000e-3, -2.6535811000e-3, & + 923.0, -5.7924928000, 1.7501447000e-3, -2.6514811000e-3, & + 924.0, -5.7938134000, 1.7490890000e-3, -2.6493836000e-3, & + 925.0, -5.7951301000, 1.7480337000e-3, -2.6472885000e-3, & + 926.0, -5.7964431000, 1.7469788000e-3, -2.6451960000e-3, & + 927.0, -5.7977523000, 1.7459242000e-3, -2.6431058000e-3, & + 928.0, -5.7990578000, 1.7448700000e-3, -2.6410182000e-3, & + 929.0, -5.8003595000, 1.7438162000e-3, -2.6389330000e-3, & + 930.0, -5.8016575000, 1.7427628000e-3, -2.6368502000e-3, & + 931.0, -5.8029518000, 1.7417098000e-3, -2.6347699000e-3, & + 932.0, -5.8042424000, 1.7406571000e-3, -2.6326921000e-3, & + 933.0, -5.8055293000, 1.7396049000e-3, -2.6306167000e-3, & + 934.0, -5.8068125000, 1.7385530000e-3, -2.6285437000e-3, & + 935.0, -5.8080920000, 1.7375015000e-3, -2.6264732000e-3, & + 936.0, -5.8093679000, 1.7364504000e-3, -2.6244051000e-3, & + 937.0, -5.8106400000, 1.7353996000e-3, -2.6223394000e-3, & + 938.0, -5.8119085000, 1.7343493000e-3, -2.6202762000e-3, & + 939.0, -5.8131734000, 1.7332993000e-3, -2.6182153000e-3, & + 940.0, -5.8144346000, 1.7322497000e-3, -2.6161569000e-3, & + 941.0, -5.8156922000, 1.7312006000e-3, -2.6141009000e-3, & + 942.0, -5.8169461000, 1.7301518000e-3, -2.6120473000e-3, & + 943.0, -5.8181965000, 1.7291034000e-3, -2.6099961000e-3, & + 944.0, -5.8194432000, 1.7280553000e-3, -2.6079473000e-3, & + 945.0, -5.8206864000, 1.7270077000e-3, -2.6059010000e-3, & + 946.0, -5.8219259000, 1.7259605000e-3, -2.6038570000e-3, & + 947.0, -5.8231619000, 1.7249137000e-3, -2.6018154000e-3, & + 948.0, -5.8243943000, 1.7238672000e-3, -2.5997761000e-3, & + 949.0, -5.8256231000, 1.7228212000e-3, -2.5977393000e-3, & + 950.0, -5.8268484000, 1.7217755000e-3, -2.5957048000e-3, & + 951.0, -5.8280701000, 1.7207303000e-3, -2.5936728000e-3, & + 952.0, -5.8292883000, 1.7196854000e-3, -2.5916430000e-3, & + 953.0, -5.8305029000, 1.7186410000e-3, -2.5896157000e-3, & + 954.0, -5.8317141000, 1.7175970000e-3, -2.5875907000e-3, & + 955.0, -5.8329217000, 1.7165533000e-3, -2.5855681000e-3, & + 956.0, -5.8341258000, 1.7155101000e-3, -2.5835478000e-3, & + 957.0, -5.8353264000, 1.7144672000e-3, -2.5815299000e-3, & + 958.0, -5.8365235000, 1.7134248000e-3, -2.5795144000e-3, & + 959.0, -5.8377172000, 1.7123828000e-3, -2.5775012000e-3, & + 960.0, -5.8389074000, 1.7113411000e-3, -2.5754903000e-3, & + 961.0, -5.8400941000, 1.7102999000e-3, -2.5734818000e-3, & + 962.0, -5.8412773000, 1.7092591000e-3, -2.5714756000e-3, & + 963.0, -5.8424571000, 1.7082187000e-3, -2.5694717000e-3, & + 964.0, -5.8436335000, 1.7071787000e-3, -2.5674702000e-3, & + 965.0, -5.8448065000, 1.7061391000e-3, -2.5654710000e-3, & + 966.0, -5.8459760000, 1.7051000000e-3, -2.5634741000e-3, & + 967.0, -5.8471421000, 1.7040612000e-3, -2.5614796000e-3, & + 968.0, -5.8483048000, 1.7030229000e-3, -2.5594873000e-3, & + 969.0, -5.8494641000, 1.7019850000e-3, -2.5574974000e-3, & + 970.0, -5.8506200000, 1.7009475000e-3, -2.5555098000e-3, & + 971.0, -5.8517725000, 1.6999104000e-3, -2.5535245000e-3, & + 972.0, -5.8529217000, 1.6988737000e-3, -2.5515415000e-3, & + 973.0, -5.8540675000, 1.6978374000e-3, -2.5495608000e-3, & + 974.0, -5.8552099000, 1.6968016000e-3, -2.5475824000e-3, & + 975.0, -5.8563490000, 1.6957662000e-3, -2.5456062000e-3, & + 976.0, -5.8574847000, 1.6947312000e-3, -2.5436324000e-3, & + 977.0, -5.8586172000, 1.6936966000e-3, -2.5416609000e-3, & + 978.0, -5.8597463000, 1.6926625000e-3, -2.5396916000e-3, & + 979.0, -5.8608720000, 1.6916288000e-3, -2.5377246000e-3, & + 980.0, -5.8619945000, 1.6905955000e-3, -2.5357599000e-3, & + 981.0, -5.8631137000, 1.6895626000e-3, -2.5337975000e-3, & + 982.0, -5.8642296000, 1.6885302000e-3, -2.5318373000e-3, & + 983.0, -5.8653422000, 1.6874982000e-3, -2.5298794000e-3, & + 984.0, -5.8664515000, 1.6864666000e-3, -2.5279238000e-3, & + 985.0, -5.8675576000, 1.6854355000e-3, -2.5259704000e-3, & + 986.0, -5.8686604000, 1.6844048000e-3, -2.5240193000e-3, & + 987.0, -5.8697599000, 1.6833745000e-3, -2.5220704000e-3, & + 988.0, -5.8708562000, 1.6823447000e-3, -2.5201238000e-3, & + 989.0, -5.8719493000, 1.6813153000e-3, -2.5181795000e-3, & + 990.0, -5.8730391000, 1.6802863000e-3, -2.5162374000e-3, & + 991.0, -5.8741258000, 1.6792578000e-3, -2.5142975000e-3, & + 992.0, -5.8752092000, 1.6782297000e-3, -2.5123598000e-3, & + 993.0, -5.8762894000, 1.6772020000e-3, -2.5104244000e-3, & + 994.0, -5.8773664000, 1.6761748000e-3, -2.5084913000e-3, & + 995.0, -5.8784403000, 1.6751480000e-3, -2.5065603000e-3, & + 996.0, -5.8795109000, 1.6741217000e-3, -2.5046316000e-3, & + 997.0, -5.8805784000, 1.6730958000e-3, -2.5027051000e-3, & + 998.0, -5.8816427000, 1.6720704000e-3, -2.5007809000e-3, & + 999.0, -5.8827039000, 1.6710454000e-3, -2.4988588000e-3, & + 1000.0, -5.8837619000, 1.6700209000e-3, -2.4969390000e-3, & + 1001.0, -5.8848168000, 1.6689968000e-3, -2.4950213000e-3, & + 1002.0, -5.8858686000, 1.6679732000e-3, -2.4931059000e-3, & + 1003.0, -5.8869172000, 1.6669500000e-3, -2.4911927000e-3, & + 1004.0, -5.8879627000, 1.6659272000e-3, -2.4892817000e-3, & + 1005.0, -5.8890051000, 1.6649049000e-3, -2.4873729000e-3, & + 1006.0, -5.8900444000, 1.6638831000e-3, -2.4854663000e-3, & + 1007.0, -5.8910807000, 1.6628617000e-3, -2.4835619000e-3, & + 1008.0, -5.8921138000, 1.6618408000e-3, -2.4816596000e-3, & + 1009.0, -5.8931439000, 1.6608204000e-3, -2.4797596000e-3, & + 1010.0, -5.8941708000, 1.6598004000e-3, -2.4778617000e-3, & + 1011.0, -5.8951948000, 1.6587808000e-3, -2.4759660000e-3, & + 1012.0, -5.8962156000, 1.6577617000e-3, -2.4740725000e-3, & + 1013.0, -5.8972335000, 1.6567431000e-3, -2.4721812000e-3, & + 1014.0, -5.8982483000, 1.6557250000e-3, -2.4702920000e-3, & + 1015.0, -5.8992600000, 1.6547073000e-3, -2.4684051000e-3, & + 1016.0, -5.9002688000, 1.6536901000e-3, -2.4665202000e-3, & + 1017.0, -5.9012745000, 1.6526733000e-3, -2.4646376000e-3, & + 1018.0, -5.9022772000, 1.6516570000e-3, -2.4627571000e-3, & + 1019.0, -5.9032769000, 1.6506412000e-3, -2.4608788000e-3, & + 1020.0, -5.9042737000, 1.6496258000e-3, -2.4590026000e-3, & + 1021.0, -5.9052674000, 1.6486109000e-3, -2.4571286000e-3, & + 1022.0, -5.9062582000, 1.6475965000e-3, -2.4552567000e-3, & + 1023.0, -5.9072460000, 1.6465826000e-3, -2.4533870000e-3, & + 1024.0, -5.9082308000, 1.6455691000e-3, -2.4515194000e-3, & + 1025.0, -5.9092127000, 1.6445561000e-3, -2.4496539000e-3, & + 1026.0, -5.9101917000, 1.6435436000e-3, -2.4477906000e-3, & + 1027.0, -5.9111677000, 1.6425316000e-3, -2.4459295000e-3, & + 1028.0, -5.9121408000, 1.6415200000e-3, -2.4440704000e-3, & + 1029.0, -5.9131109000, 1.6405089000e-3, -2.4422135000e-3, & + 1030.0, -5.9140782000, 1.6394983000e-3, -2.4403587000e-3, & + 1031.0, -5.9150425000, 1.6384882000e-3, -2.4385061000e-3, & + 1032.0, -5.9160039000, 1.6374786000e-3, -2.4366555000e-3, & + 1033.0, -5.9169625000, 1.6364694000e-3, -2.4348071000e-3, & + 1034.0, -5.9179181000, 1.6354607000e-3, -2.4329608000e-3, & + 1035.0, -5.9188709000, 1.6344526000e-3, -2.4311166000e-3, & + 1036.0, -5.9198208000, 1.6334449000e-3, -2.4292746000e-3, & + 1037.0, -5.9207678000, 1.6324377000e-3, -2.4274346000e-3, & + 1038.0, -5.9217120000, 1.6314309000e-3, -2.4255967000e-3, & + 1039.0, -5.9226533000, 1.6304247000e-3, -2.4237610000e-3, & + 1040.0, -5.9235918000, 1.6294190000e-3, -2.4219273000e-3, & + 1041.0, -5.9245275000, 1.6284137000e-3, -2.4200958000e-3, & + 1042.0, -5.9254603000, 1.6274090000e-3, -2.4182663000e-3, & + 1043.0, -5.9263904000, 1.6264047000e-3, -2.4164389000e-3, & + 1044.0, -5.9273176000, 1.6254009000e-3, -2.4146136000e-3, & + 1045.0, -5.9282420000, 1.6243977000e-3, -2.4127904000e-3, & + 1046.0, -5.9291636000, 1.6233949000e-3, -2.4109693000e-3, & + 1047.0, -5.9300824000, 1.6223926000e-3, -2.4091503000e-3, & + 1048.0, -5.9309984000, 1.6213909000e-3, -2.4073333000e-3, & + 1049.0, -5.9319117000, 1.6203896000e-3, -2.4055185000e-3, & + 1050.0, -5.9328222000, 1.6193888000e-3, -2.4037057000e-3, & + 1051.0, -5.9337299000, 1.6183886000e-3, -2.4018949000e-3, & + 1052.0, -5.9346349000, 1.6173888000e-3, -2.4000862000e-3, & + 1053.0, -5.9355371000, 1.6163895000e-3, -2.3982796000e-3, & + 1054.0, -5.9364366000, 1.6153908000e-3, -2.3964751000e-3, & + 1055.0, -5.9373334000, 1.6143925000e-3, -2.3946726000e-3, & + 1056.0, -5.9382274000, 1.6133948000e-3, -2.3928722000e-3, & + 1057.0, -5.9391187000, 1.6123976000e-3, -2.3910738000e-3, & + 1058.0, -5.9400074000, 1.6114009000e-3, -2.3892775000e-3, & + 1059.0, -5.9408933000, 1.6104046000e-3, -2.3874833000e-3, & + 1060.0, -5.9417765000, 1.6094089000e-3, -2.3856910000e-3, & + 1061.0, -5.9426570000, 1.6084138000e-3, -2.3839009000e-3, & + 1062.0, -5.9435349000, 1.6074191000e-3, -2.3821127000e-3, & + 1063.0, -5.9444100000, 1.6064249000e-3, -2.3803266000e-3, & + 1064.0, -5.9452825000, 1.6054313000e-3, -2.3785426000e-3, & + 1065.0, -5.9461524000, 1.6044382000e-3, -2.3767606000e-3, & + 1066.0, -5.9470196000, 1.6034456000e-3, -2.3749806000e-3, & + 1067.0, -5.9478841000, 1.6024535000e-3, -2.3732026000e-3, & + 1068.0, -5.9487460000, 1.6014619000e-3, -2.3714267000e-3, & + 1069.0, -5.9496053000, 1.6004709000e-3, -2.3696528000e-3, & + 1070.0, -5.9504619000, 1.5994804000e-3, -2.3678809000e-3, & + 1071.0, -5.9513160000, 1.5984904000e-3, -2.3661110000e-3, & + 1072.0, -5.9521674000, 1.5975009000e-3, -2.3643432000e-3, & + 1073.0, -5.9530162000, 1.5965120000e-3, -2.3625773000e-3, & + 1074.0, -5.9538624000, 1.5955236000e-3, -2.3608135000e-3, & + 1075.0, -5.9547061000, 1.5945357000e-3, -2.3590517000e-3, & + 1076.0, -5.9555471000, 1.5935483000e-3, -2.3572919000e-3, & + 1077.0, -5.9563856000, 1.5925615000e-3, -2.3555341000e-3, & + 1078.0, -5.9572215000, 1.5915752000e-3, -2.3537782000e-3, & + 1079.0, -5.9580548000, 1.5905894000e-3, -2.3520244000e-3, & + 1080.0, -5.9588856000, 1.5896041000e-3, -2.3502726000e-3, & + 1081.0, -5.9597138000, 1.5886194000e-3, -2.3485228000e-3, & + 1082.0, -5.9605395000, 1.5876353000e-3, -2.3467750000e-3, & + 1083.0, -5.9613627000, 1.5866516000e-3, -2.3450292000e-3, & + 1084.0, -5.9621833000, 1.5856685000e-3, -2.3432853000e-3, & + 1085.0, -5.9630014000, 1.5846860000e-3, -2.3415434000e-3, & + 1086.0, -5.9638170000, 1.5837039000e-3, -2.3398036000e-3, & + 1087.0, -5.9646301000, 1.5827224000e-3, -2.3380657000e-3, & + 1088.0, -5.9654407000, 1.5817415000e-3, -2.3363297000e-3, & + 1089.0, -5.9662488000, 1.5807611000e-3, -2.3345958000e-3, & + 1090.0, -5.9670544000, 1.5797812000e-3, -2.3328638000e-3, & + 1091.0, -5.9678575000, 1.5788019000e-3, -2.3311338000e-3, & + 1092.0, -5.9686582000, 1.5778231000e-3, -2.3294057000e-3, & + 1093.0, -5.9694563000, 1.5768449000e-3, -2.3276797000e-3, & + 1094.0, -5.9702521000, 1.5758672000e-3, -2.3259555000e-3, & + 1095.0, -5.9710453000, 1.5748901000e-3, -2.3242334000e-3, & + 1096.0, -5.9718361000, 1.5739135000e-3, -2.3225132000e-3, & + 1097.0, -5.9726245000, 1.5729374000e-3, -2.3207950000e-3, & + 1098.0, -5.9734105000, 1.5719619000e-3, -2.3190787000e-3, & + 1099.0, -5.9741940000, 1.5709870000e-3, -2.3173643000e-3, & + 1100.0, -5.9749751000, 1.5700126000e-3, -2.3156519000e-3, & + 1101.0, -5.9757538000, 1.5690387000e-3, -2.3139415000e-3, & + 1102.0, -5.9765300000, 1.5680654000e-3, -2.3122330000e-3, & + 1103.0, -5.9773039000, 1.5670927000e-3, -2.3105264000e-3, & + 1104.0, -5.9780754000, 1.5661205000e-3, -2.3088218000e-3, & + 1105.0, -5.9788445000, 1.5651489000e-3, -2.3071191000e-3, & + 1106.0, -5.9796112000, 1.5641778000e-3, -2.3054184000e-3, & + 1107.0, -5.9803755000, 1.5632073000e-3, -2.3037195000e-3, & + 1108.0, -5.9811375000, 1.5622374000e-3, -2.3020226000e-3, & + 1109.0, -5.9818971000, 1.5612680000e-3, -2.3003277000e-3, & + 1110.0, -5.9826543000, 1.5602991000e-3, -2.2986346000e-3, & + 1111.0, -5.9834092000, 1.5593309000e-3, -2.2969435000e-3, & + 1112.0, -5.9841618000, 1.5583632000e-3, -2.2952543000e-3, & + 1113.0, -5.9849120000, 1.5573960000e-3, -2.2935670000e-3, & + 1114.0, -5.9856599000, 1.5564294000e-3, -2.2918817000e-3, & + 1115.0, -5.9864054000, 1.5554634000e-3, -2.2901982000e-3, & + 1116.0, -5.9871487000, 1.5544979000e-3, -2.2885167000e-3, & + 1117.0, -5.9878896000, 1.5535331000e-3, -2.2868370000e-3, & + 1118.0, -5.9886282000, 1.5525687000e-3, -2.2851593000e-3, & + 1119.0, -5.9893646000, 1.5516050000e-3, -2.2834835000e-3, & + 1120.0, -5.9900986000, 1.5506418000e-3, -2.2818095000e-3, & + 1121.0, -5.9908304000, 1.5496792000e-3, -2.2801375000e-3, & + 1122.0, -5.9915599000, 1.5487171000e-3, -2.2784674000e-3, & + 1123.0, -5.9922871000, 1.5477557000e-3, -2.2767991000e-3, & + 1124.0, -5.9930120000, 1.5467948000e-3, -2.2751328000e-3, & + 1125.0, -5.9937347000, 1.5458344000e-3, -2.2734683000e-3, & + 1126.0, -5.9944551000, 1.5448747000e-3, -2.2718058000e-3, & + 1127.0, -5.9951733000, 1.5439155000e-3, -2.2701451000e-3, & + 1128.0, -5.9958892000, 1.5429569000e-3, -2.2684863000e-3, & + 1129.0, -5.9966029000, 1.5419989000e-3, -2.2668294000e-3, & + 1130.0, -5.9973144000, 1.5410414000e-3, -2.2651743000e-3, & + 1131.0, -5.9980236000, 1.5400845000e-3, -2.2635212000e-3, & + 1132.0, -5.9987307000, 1.5391282000e-3, -2.2618699000e-3, & + 1133.0, -5.9994355000, 1.5381725000e-3, -2.2602205000e-3, & + 1134.0, -6.0001381000, 1.5372174000e-3, -2.2585729000e-3, & + 1135.0, -6.0008385000, 1.5362628000e-3, -2.2569272000e-3, & + 1136.0, -6.0015367000, 1.5353089000e-3, -2.2552834000e-3, & + 1137.0, -6.0022328000, 1.5343555000e-3, -2.2536414000e-3, & + 1138.0, -6.0029266000, 1.5334027000e-3, -2.2520013000e-3, & + 1139.0, -6.0036183000, 1.5324504000e-3, -2.2503631000e-3, & + 1140.0, -6.0043078000, 1.5314988000e-3, -2.2487267000e-3, & + 1141.0, -6.0049952000, 1.5305477000e-3, -2.2470922000e-3, & + 1142.0, -6.0056804000, 1.5295973000e-3, -2.2454595000e-3, & + 1143.0, -6.0063635000, 1.5286474000e-3, -2.2438287000e-3, & + 1144.0, -6.0070444000, 1.5276981000e-3, -2.2421997000e-3, & + 1145.0, -6.0077231000, 1.5267494000e-3, -2.2405726000e-3, & + 1146.0, -6.0083998000, 1.5258013000e-3, -2.2389473000e-3, & + 1147.0, -6.0090743000, 1.5248538000e-3, -2.2373238000e-3, & + 1148.0, -6.0097467000, 1.5239068000e-3, -2.2357022000e-3, & + 1149.0, -6.0104170000, 1.5229605000e-3, -2.2340824000e-3, & + 1150.0, -6.0110851000, 1.5220147000e-3, -2.2324645000e-3, & + 1151.0, -6.0117512000, 1.5210696000e-3, -2.2308484000e-3, & + 1152.0, -6.0124152000, 1.5201250000e-3, -2.2292341000e-3, & + 1153.0, -6.0130771000, 1.5191811000e-3, -2.2276216000e-3, & + 1154.0, -6.0137369000, 1.5182377000e-3, -2.2260110000e-3, & + 1155.0, -6.0143946000, 1.5172949000e-3, -2.2244022000e-3, & + 1156.0, -6.0150502000, 1.5163527000e-3, -2.2227952000e-3, & + 1157.0, -6.0157038000, 1.5154112000e-3, -2.2211900000e-3, & + 1158.0, -6.0163553000, 1.5144702000e-3, -2.2195866000e-3, & + 1159.0, -6.0170048000, 1.5135298000e-3, -2.2179851000e-3, & + 1160.0, -6.0176522000, 1.5125900000e-3, -2.2163853000e-3, & + 1161.0, -6.0182976000, 1.5116508000e-3, -2.2147874000e-3, & + 1162.0, -6.0189409000, 1.5107122000e-3, -2.2131913000e-3, & + 1163.0, -6.0195822000, 1.5097742000e-3, -2.2115970000e-3, & + 1164.0, -6.0202215000, 1.5088369000e-3, -2.2100045000e-3, & + 1165.0, -6.0208588000, 1.5079001000e-3, -2.2084138000e-3, & + 1166.0, -6.0214940000, 1.5069639000e-3, -2.2068249000e-3, & + 1167.0, -6.0221273000, 1.5060283000e-3, -2.2052377000e-3, & + 1168.0, -6.0227585000, 1.5050934000e-3, -2.2036524000e-3, & + 1169.0, -6.0233877000, 1.5041590000e-3, -2.2020689000e-3, & + 1170.0, -6.0240150000, 1.5032253000e-3, -2.2004872000e-3, & + 1171.0, -6.0246402000, 1.5022921000e-3, -2.1989072000e-3, & + 1172.0, -6.0252635000, 1.5013596000e-3, -2.1973290000e-3, & + 1173.0, -6.0258848000, 1.5004276000e-3, -2.1957527000e-3, & + 1174.0, -6.0265042000, 1.4994963000e-3, -2.1941781000e-3, & + 1175.0, -6.0271215000, 1.4985656000e-3, -2.1926052000e-3, & + 1176.0, -6.0277369000, 1.4976355000e-3, -2.1910342000e-3, & + 1177.0, -6.0283504000, 1.4967060000e-3, -2.1894649000e-3, & + 1178.0, -6.0289619000, 1.4957771000e-3, -2.1878974000e-3, & + 1179.0, -6.0295715000, 1.4948489000e-3, -2.1863317000e-3, & + 1180.0, -6.0301791000, 1.4939212000e-3, -2.1847678000e-3, & + 1181.0, -6.0307848000, 1.4929942000e-3, -2.1832056000e-3, & + 1182.0, -6.0313886000, 1.4920677000e-3, -2.1816451000e-3, & + 1183.0, -6.0319905000, 1.4911419000e-3, -2.1800865000e-3, & + 1184.0, -6.0325904000, 1.4902167000e-3, -2.1785296000e-3, & + 1185.0, -6.0331885000, 1.4892921000e-3, -2.1769744000e-3, & + 1186.0, -6.0337846000, 1.4883682000e-3, -2.1754210000e-3, & + 1187.0, -6.0343789000, 1.4874448000e-3, -2.1738694000e-3, & + 1188.0, -6.0349712000, 1.4865221000e-3, -2.1723195000e-3, & + 1189.0, -6.0355617000, 1.4856000000e-3, -2.1707714000e-3, & + 1190.0, -6.0361503000, 1.4846785000e-3, -2.1692250000e-3, & + 1191.0, -6.0367370000, 1.4837576000e-3, -2.1676804000e-3, & + 1192.0, -6.0373218000, 1.4828373000e-3, -2.1661375000e-3, & + 1193.0, -6.0379048000, 1.4819177000e-3, -2.1645963000e-3, & + 1194.0, -6.0384859000, 1.4809986000e-3, -2.1630569000e-3, & + 1195.0, -6.0390651000, 1.4800802000e-3, -2.1615192000e-3, & + 1196.0, -6.0396426000, 1.4791625000e-3, -2.1599833000e-3, & + 1197.0, -6.0402181000, 1.4782453000e-3, -2.1584490000e-3, & + 1198.0, -6.0407919000, 1.4773288000e-3, -2.1569166000e-3, & + 1199.0, -6.0413638000, 1.4764129000e-3, -2.1553858000e-3, & + 1200.0, -6.0419338000, 1.4754976000e-3, -2.1538568000e-3, & + 1201.0, -6.0425021000, 1.4745829000e-3, -2.1523295000e-3, & + 1202.0, -6.0430685000, 1.4736689000e-3, -2.1508039000e-3, & + 1203.0, -6.0436331000, 1.4727555000e-3, -2.1492800000e-3, & + 1204.0, -6.0441959000, 1.4718427000e-3, -2.1477579000e-3, & + 1205.0, -6.0447570000, 1.4709305000e-3, -2.1462375000e-3, & + 1206.0, -6.0453162000, 1.4700190000e-3, -2.1447188000e-3, & + 1207.0, -6.0458736000, 1.4691081000e-3, -2.1432018000e-3, & + 1208.0, -6.0464292000, 1.4681978000e-3, -2.1416865000e-3, & + 1209.0, -6.0469831000, 1.4672882000e-3, -2.1401729000e-3, & + 1210.0, -6.0475352000, 1.4663791000e-3, -2.1386610000e-3, & + 1211.0, -6.0480855000, 1.4654707000e-3, -2.1371509000e-3, & + 1212.0, -6.0486341000, 1.4645630000e-3, -2.1356424000e-3, & + 1213.0, -6.0491809000, 1.4636558000e-3, -2.1341356000e-3, & + 1214.0, -6.0497259000, 1.4627493000e-3, -2.1326306000e-3, & + 1215.0, -6.0502692000, 1.4618435000e-3, -2.1311272000e-3, & + 1216.0, -6.0508107000, 1.4609382000e-3, -2.1296255000e-3, & + 1217.0, -6.0513505000, 1.4600336000e-3, -2.1281255000e-3, & + 1218.0, -6.0518886000, 1.4591297000e-3, -2.1266272000e-3, & + 1219.0, -6.0524250000, 1.4582263000e-3, -2.1251306000e-3, & + 1220.0, -6.0529596000, 1.4573236000e-3, -2.1236357000e-3, & + 1221.0, -6.0534925000, 1.4564215000e-3, -2.1221424000e-3, & + 1222.0, -6.0540237000, 1.4555201000e-3, -2.1206509000e-3, & + 1223.0, -6.0545531000, 1.4546193000e-3, -2.1191610000e-3, & + 1224.0, -6.0550809000, 1.4537191000e-3, -2.1176728000e-3, & + 1225.0, -6.0556070000, 1.4528196000e-3, -2.1161863000e-3, & + 1226.0, -6.0561314000, 1.4519207000e-3, -2.1147014000e-3, & + 1227.0, -6.0566541000, 1.4510224000e-3, -2.1132182000e-3, & + 1228.0, -6.0571751000, 1.4501248000e-3, -2.1117367000e-3, & + 1229.0, -6.0576944000, 1.4492278000e-3, -2.1102569000e-3, & + 1230.0, -6.0582120000, 1.4483315000e-3, -2.1087787000e-3, & + 1231.0, -6.0587280000, 1.4474358000e-3, -2.1073022000e-3, & + 1232.0, -6.0592424000, 1.4465407000e-3, -2.1058273000e-3, & + 1233.0, -6.0597550000, 1.4456463000e-3, -2.1043541000e-3, & + 1234.0, -6.0602660000, 1.4447525000e-3, -2.1028826000e-3, & + 1235.0, -6.0607754000, 1.4438593000e-3, -2.1014127000e-3, & + 1236.0, -6.0612831000, 1.4429668000e-3, -2.0999445000e-3, & + 1237.0, -6.0617892000, 1.4420750000e-3, -2.0984779000e-3, & + 1238.0, -6.0622936000, 1.4411837000e-3, -2.0970130000e-3, & + 1239.0, -6.0627964000, 1.4402931000e-3, -2.0955497000e-3, & + 1240.0, -6.0632976000, 1.4394032000e-3, -2.0940880000e-3, & + 1241.0, -6.0637972000, 1.4385139000e-3, -2.0926281000e-3, & + 1242.0, -6.0642951000, 1.4376252000e-3, -2.0911697000e-3, & + 1243.0, -6.0647914000, 1.4367372000e-3, -2.0897130000e-3, & + 1244.0, -6.0652862000, 1.4358498000e-3, -2.0882579000e-3, & + 1245.0, -6.0657793000, 1.4349631000e-3, -2.0868045000e-3, & + 1246.0, -6.0662708000, 1.4340770000e-3, -2.0853527000e-3, & + 1247.0, -6.0667608000, 1.4331916000e-3, -2.0839025000e-3, & + 1248.0, -6.0672491000, 1.4323068000e-3, -2.0824540000e-3, & + 1249.0, -6.0677359000, 1.4314226000e-3, -2.0810070000e-3, & + 1250.0, -6.0682211000, 1.4305391000e-3, -2.0795618000e-3, & + 1251.0, -6.0687047000, 1.4296562000e-3, -2.0781181000e-3, & + 1252.0, -6.0691867000, 1.4287740000e-3, -2.0766760000e-3, & + 1253.0, -6.0696672000, 1.4278925000e-3, -2.0752356000e-3, & + 1254.0, -6.0701462000, 1.4270115000e-3, -2.0737968000e-3, & + 1255.0, -6.0706235000, 1.4261312000e-3, -2.0723596000e-3, & + 1256.0, -6.0710993000, 1.4252516000e-3, -2.0709241000e-3, & + 1257.0, -6.0715736000, 1.4243726000e-3, -2.0694901000e-3, & + 1258.0, -6.0720464000, 1.4234943000e-3, -2.0680577000e-3, & + 1259.0, -6.0725175000, 1.4226166000e-3, -2.0666270000e-3, & + 1260.0, -6.0729872000, 1.4217396000e-3, -2.0651979000e-3, & + 1261.0, -6.0734554000, 1.4208632000e-3, -2.0637703000e-3, & + 1262.0, -6.0739220000, 1.4199874000e-3, -2.0623444000e-3, & + 1263.0, -6.0743871000, 1.4191123000e-3, -2.0609201000e-3, & + 1264.0, -6.0748507000, 1.4182379000e-3, -2.0594973000e-3, & + 1265.0, -6.0753127000, 1.4173641000e-3, -2.0580762000e-3, & + 1266.0, -6.0757733000, 1.4164910000e-3, -2.0566566000e-3, & + 1267.0, -6.0762324000, 1.4156185000e-3, -2.0552387000e-3, & + 1268.0, -6.0766899000, 1.4147466000e-3, -2.0538223000e-3, & + 1269.0, -6.0771460000, 1.4138754000e-3, -2.0524076000e-3, & + 1270.0, -6.0776006000, 1.4130049000e-3, -2.0509944000e-3, & + 1271.0, -6.0780537000, 1.4121350000e-3, -2.0495828000e-3, & + 1272.0, -6.0785054000, 1.4112658000e-3, -2.0481728000e-3, & + 1273.0, -6.0789555000, 1.4103972000e-3, -2.0467643000e-3, & + 1274.0, -6.0794042000, 1.4095293000e-3, -2.0453575000e-3, & + 1275.0, -6.0798515000, 1.4086620000e-3, -2.0439522000e-3, & + 1276.0, -6.0802972000, 1.4077954000e-3, -2.0425485000e-3, & + 1277.0, -6.0807415000, 1.4069294000e-3, -2.0411464000e-3, & + 1278.0, -6.0811844000, 1.4060641000e-3, -2.0397458000e-3, & + 1279.0, -6.0816258000, 1.4051994000e-3, -2.0383468000e-3, & + 1280.0, -6.0820658000, 1.4043354000e-3, -2.0369494000e-3, & + 1281.0, -6.0825043000, 1.4034720000e-3, -2.0355536000e-3, & + 1282.0, -6.0829414000, 1.4026093000e-3, -2.0341593000e-3, & + 1283.0, -6.0833771000, 1.4017473000e-3, -2.0327665000e-3, & + 1284.0, -6.0838114000, 1.4008859000e-3, -2.0313754000e-3, & + 1285.0, -6.0842442000, 1.4000251000e-3, -2.0299858000e-3, & + 1286.0, -6.0846756000, 1.3991650000e-3, -2.0285977000e-3, & + 1287.0, -6.0851056000, 1.3983056000e-3, -2.0272112000e-3, & + 1288.0, -6.0855342000, 1.3974468000e-3, -2.0258263000e-3, & + 1289.0, -6.0859614000, 1.3965887000e-3, -2.0244429000e-3, & + 1290.0, -6.0863871000, 1.3957312000e-3, -2.0230610000e-3, & + 1291.0, -6.0868115000, 1.3948744000e-3, -2.0216807000e-3, & + 1292.0, -6.0872345000, 1.3940183000e-3, -2.0203020000e-3, & + 1293.0, -6.0876561000, 1.3931628000e-3, -2.0189247000e-3, & + 1294.0, -6.0880764000, 1.3923079000e-3, -2.0175491000e-3, & + 1295.0, -6.0884952000, 1.3914537000e-3, -2.0161749000e-3, & + 1296.0, -6.0889127000, 1.3906002000e-3, -2.0148024000e-3, & + 1297.0, -6.0893288000, 1.3897473000e-3, -2.0134313000e-3, & + 1298.0, -6.0897435000, 1.3888951000e-3, -2.0120618000e-3, & + 1299.0, -6.0901569000, 1.3880436000e-3, -2.0106938000e-3, & + 1300.0, -6.0905689000, 1.3871927000e-3, -2.0093273000e-3, & + 1301.0, -6.0909796000, 1.3863424000e-3, -2.0079624000e-3, & + 1302.0, -6.0913889000, 1.3854928000e-3, -2.0065990000e-3, & + 1303.0, -6.0917969000, 1.3846439000e-3, -2.0052371000e-3, & + 1304.0, -6.0922035000, 1.3837956000e-3, -2.0038767000e-3, & + 1305.0, -6.0926088000, 1.3829480000e-3, -2.0025179000e-3, & + 1306.0, -6.0930127000, 1.3821011000e-3, -2.0011606000e-3, & + 1307.0, -6.0934154000, 1.3812548000e-3, -1.9998048000e-3, & + 1308.0, -6.0938167000, 1.3804091000e-3, -1.9984505000e-3, & + 1309.0, -6.0942166000, 1.3795642000e-3, -1.9970977000e-3, & + 1310.0, -6.0946153000, 1.3787199000e-3, -1.9957464000e-3, & + 1311.0, -6.0950127000, 1.3778762000e-3, -1.9943967000e-3, & + 1312.0, -6.0954087000, 1.3770332000e-3, -1.9930484000e-3, & + 1313.0, -6.0958034000, 1.3761909000e-3, -1.9917017000e-3, & + 1314.0, -6.0961969000, 1.3753492000e-3, -1.9903564000e-3, & + 1315.0, -6.0965890000, 1.3745082000e-3, -1.9890127000e-3, & + 1316.0, -6.0969798000, 1.3736678000e-3, -1.9876705000e-3, & + 1317.0, -6.0973694000, 1.3728281000e-3, -1.9863297000e-3, & + 1318.0, -6.0977577000, 1.3719890000e-3, -1.9849905000e-3, & + 1319.0, -6.0981446000, 1.3711507000e-3, -1.9836527000e-3, & + 1320.0, -6.0985303000, 1.3703129000e-3, -1.9823165000e-3, & + 1321.0, -6.0989148000, 1.3694759000e-3, -1.9809817000e-3, & + 1322.0, -6.0992979000, 1.3686395000e-3, -1.9796485000e-3, & + 1323.0, -6.0996798000, 1.3678037000e-3, -1.9783167000e-3, & + 1324.0, -6.1000605000, 1.3669686000e-3, -1.9769864000e-3, & + 1325.0, -6.1004399000, 1.3661342000e-3, -1.9756576000e-3, & + 1326.0, -6.1008180000, 1.3653005000e-3, -1.9743302000e-3, & + 1327.0, -6.1011948000, 1.3644674000e-3, -1.9730044000e-3, & + 1328.0, -6.1015705000, 1.3636349000e-3, -1.9716800000e-3, & + 1329.0, -6.1019449000, 1.3628031000e-3, -1.9703571000e-3, & + 1330.0, -6.1023180000, 1.3619720000e-3, -1.9690357000e-3, & + 1331.0, -6.1026899000, 1.3611416000e-3, -1.9677157000e-3, & + 1332.0, -6.1030606000, 1.3603118000e-3, -1.9663972000e-3, & + 1333.0, -6.1034300000, 1.3594826000e-3, -1.9650802000e-3, & + 1334.0, -6.1037983000, 1.3586541000e-3, -1.9637647000e-3, & + 1335.0, -6.1041653000, 1.3578263000e-3, -1.9624506000e-3, & + 1336.0, -6.1045311000, 1.3569992000e-3, -1.9611380000e-3, & + 1337.0, -6.1048956000, 1.3561727000e-3, -1.9598268000e-3, & + 1338.0, -6.1052590000, 1.3553468000e-3, -1.9585171000e-3, & + 1339.0, -6.1056212000, 1.3545217000e-3, -1.9572089000e-3, & + 1340.0, -6.1059821000, 1.3536972000e-3, -1.9559021000e-3, & + 1341.0, -6.1063419000, 1.3528733000e-3, -1.9545968000e-3, & + 1342.0, -6.1067005000, 1.3520501000e-3, -1.9532929000e-3, & + 1343.0, -6.1070578000, 1.3512276000e-3, -1.9519905000e-3, & + 1344.0, -6.1074140000, 1.3504057000e-3, -1.9506896000e-3, & + 1345.0, -6.1077690000, 1.3495845000e-3, -1.9493900000e-3, & + 1346.0, -6.1081229000, 1.3487640000e-3, -1.9480920000e-3, & + 1347.0, -6.1084755000, 1.3479441000e-3, -1.9467953000e-3, & + 1348.0, -6.1088270000, 1.3471249000e-3, -1.9455001000e-3, & + 1349.0, -6.1091773000, 1.3463063000e-3, -1.9442064000e-3, & + 1350.0, -6.1095265000, 1.3454884000e-3, -1.9429141000e-3, & + 1351.0, -6.1098744000, 1.3446712000e-3, -1.9416232000e-3, & + 1352.0, -6.1102213000, 1.3438546000e-3, -1.9403338000e-3, & + 1353.0, -6.1105669000, 1.3430387000e-3, -1.9390458000e-3, & + 1354.0, -6.1109115000, 1.3422234000e-3, -1.9377592000e-3, & + 1355.0, -6.1112548000, 1.3414088000e-3, -1.9364741000e-3, & + 1356.0, -6.1115971000, 1.3405949000e-3, -1.9351903000e-3, & + 1357.0, -6.1119382000, 1.3397816000e-3, -1.9339081000e-3, & + 1358.0, -6.1122781000, 1.3389690000e-3, -1.9326272000e-3, & + 1359.0, -6.1126170000, 1.3381571000e-3, -1.9313478000e-3, & + 1360.0, -6.1129546000, 1.3373458000e-3, -1.9300697000e-3, & + 1361.0, -6.1132912000, 1.3365352000e-3, -1.9287931000e-3, & + 1362.0, -6.1136267000, 1.3357252000e-3, -1.9275180000e-3, & + 1363.0, -6.1139610000, 1.3349159000e-3, -1.9262442000e-3, & + 1364.0, -6.1142942000, 1.3341073000e-3, -1.9249718000e-3, & + 1365.0, -6.1146263000, 1.3332993000e-3, -1.9237009000e-3, & + 1366.0, -6.1149573000, 1.3324920000e-3, -1.9224314000e-3, & + 1367.0, -6.1152872000, 1.3316853000e-3, -1.9211632000e-3, & + 1368.0, -6.1156160000, 1.3308793000e-3, -1.9198965000e-3, & + 1369.0, -6.1159437000, 1.3300740000e-3, -1.9186312000e-3, & + 1370.0, -6.1162702000, 1.3292693000e-3, -1.9173673000e-3, & + 1371.0, -6.1165957000, 1.3284653000e-3, -1.9161048000e-3, & + 1372.0, -6.1169202000, 1.3276619000e-3, -1.9148437000e-3, & + 1373.0, -6.1172435000, 1.3268592000e-3, -1.9135840000e-3, & + 1374.0, -6.1175657000, 1.3260572000e-3, -1.9123257000e-3, & + 1375.0, -6.1178869000, 1.3252558000e-3, -1.9110688000e-3, & + 1376.0, -6.1182070000, 1.3244551000e-3, -1.9098133000e-3, & + 1377.0, -6.1185260000, 1.3236551000e-3, -1.9085591000e-3, & + 1378.0, -6.1188440000, 1.3228557000e-3, -1.9073064000e-3, & + 1379.0, -6.1191609000, 1.3220569000e-3, -1.9060550000e-3, & + 1380.0, -6.1194767000, 1.3212589000e-3, -1.9048051000e-3, & + 1381.0, -6.1197915000, 1.3204614000e-3, -1.9035565000e-3, & + 1382.0, -6.1201052000, 1.3196647000e-3, -1.9023093000e-3, & + 1383.0, -6.1204179000, 1.3188686000e-3, -1.9010635000e-3, & + 1384.0, -6.1207295000, 1.3180732000e-3, -1.8998190000e-3, & + 1385.0, -6.1210401000, 1.3172784000e-3, -1.8985760000e-3, & + 1386.0, -6.1213496000, 1.3164843000e-3, -1.8973343000e-3, & + 1387.0, -6.1216581000, 1.3156908000e-3, -1.8960940000e-3, & + 1388.0, -6.1219656000, 1.3148980000e-3, -1.8948550000e-3, & + 1389.0, -6.1222720000, 1.3141059000e-3, -1.8936175000e-3, & + 1390.0, -6.1225774000, 1.3133144000e-3, -1.8923813000e-3, & + 1391.0, -6.1228818000, 1.3125236000e-3, -1.8911464000e-3, & + 1392.0, -6.1231851000, 1.3117334000e-3, -1.8899130000e-3, & + 1393.0, -6.1234875000, 1.3109439000e-3, -1.8886809000e-3, & + 1394.0, -6.1237888000, 1.3101551000e-3, -1.8874501000e-3, & + 1395.0, -6.1240891000, 1.3093669000e-3, -1.8862207000e-3, & + 1396.0, -6.1243884000, 1.3085794000e-3, -1.8849927000e-3, & + 1397.0, -6.1246867000, 1.3077925000e-3, -1.8837660000e-3, & + 1398.0, -6.1249840000, 1.3070063000e-3, -1.8825407000e-3, & + 1399.0, -6.1252803000, 1.3062208000e-3, -1.8813168000e-3, & + 1400.0, -6.1255756000, 1.3054359000e-3, -1.8800942000e-3, & + 1401.0, -6.1258699000, 1.3046517000e-3, -1.8788729000e-3, & + 1402.0, -6.1261632000, 1.3038681000e-3, -1.8776530000e-3, & + 1403.0, -6.1264555000, 1.3030852000e-3, -1.8764345000e-3, & + 1404.0, -6.1267469000, 1.3023029000e-3, -1.8752172000e-3, & + 1405.0, -6.1270372000, 1.3015213000e-3, -1.8740014000e-3, & + 1406.0, -6.1273266000, 1.3007404000e-3, -1.8727868000e-3, & + 1407.0, -6.1276150000, 1.2999601000e-3, -1.8715736000e-3, & + 1408.0, -6.1279024000, 1.2991804000e-3, -1.8703618000e-3, & + 1409.0, -6.1281889000, 1.2984015000e-3, -1.8691513000e-3, & + 1410.0, -6.1284744000, 1.2976231000e-3, -1.8679421000e-3, & + 1411.0, -6.1287590000, 1.2968455000e-3, -1.8667343000e-3, & + 1412.0, -6.1290425000, 1.2960685000e-3, -1.8655277000e-3, & + 1413.0, -6.1293252000, 1.2952921000e-3, -1.8643226000e-3, & + 1414.0, -6.1296068000, 1.2945164000e-3, -1.8631187000e-3, & + 1415.0, -6.1298876000, 1.2937414000e-3, -1.8619162000e-3, & + 1416.0, -6.1301673000, 1.2929670000e-3, -1.8607150000e-3, & + 1417.0, -6.1304462000, 1.2921933000e-3, -1.8595151000e-3, & + 1418.0, -6.1307241000, 1.2914202000e-3, -1.8583165000e-3, & + 1419.0, -6.1310010000, 1.2906478000e-3, -1.8571193000e-3, & + 1420.0, -6.1312770000, 1.2898761000e-3, -1.8559234000e-3, & + 1421.0, -6.1315521000, 1.2891050000e-3, -1.8547288000e-3, & + 1422.0, -6.1318263000, 1.2883345000e-3, -1.8535355000e-3, & + 1423.0, -6.1320995000, 1.2875647000e-3, -1.8523435000e-3, & + 1424.0, -6.1323718000, 1.2867956000e-3, -1.8511528000e-3, & + 1425.0, -6.1326432000, 1.2860271000e-3, -1.8499635000e-3, & + 1426.0, -6.1329136000, 1.2852592000e-3, -1.8487754000e-3, & + 1427.0, -6.1331832000, 1.2844921000e-3, -1.8475887000e-3, & + 1428.0, -6.1334518000, 1.2837255000e-3, -1.8464033000e-3, & + 1429.0, -6.1337196000, 1.2829597000e-3, -1.8452191000e-3, & + 1430.0, -6.1339864000, 1.2821945000e-3, -1.8440363000e-3, & + 1431.0, -6.1342523000, 1.2814299000e-3, -1.8428548000e-3, & + 1432.0, -6.1345173000, 1.2806660000e-3, -1.8416745000e-3, & + 1433.0, -6.1347815000, 1.2799027000e-3, -1.8404956000e-3, & + 1434.0, -6.1350447000, 1.2791401000e-3, -1.8393180000e-3, & + 1435.0, -6.1353070000, 1.2783782000e-3, -1.8381416000e-3, & + 1436.0, -6.1355685000, 1.2776168000e-3, -1.8369666000e-3, & + 1437.0, -6.1358290000, 1.2768562000e-3, -1.8357928000e-3, & + 1438.0, -6.1360887000, 1.2760962000e-3, -1.8346203000e-3, & + 1439.0, -6.1363475000, 1.2753368000e-3, -1.8334492000e-3, & + 1440.0, -6.1366054000, 1.2745781000e-3, -1.8322792000e-3 & + /), (/4, lmax+1/)) !< Load Love numbers + +!> \namespace mom_load_love_numbers +!! This module serves the sole purpose of storing load Love number. The Love numbers are used for the self-attraction +!! and loading (SAL) calculation, which is currently embedded in MOM_tidal_forcing module. This separate module ensures +!! the readability of the tidal module. +!! +!! Variable Love_Data stores the Love numbers up to degree 1440. From left to right: degree, h, l, and k. Data in this +!! module is imported from SAL calculation in Model for Prediction Across Scales (MPAS)-Ocean developed by Los Alamos +!! National Laboratory and University of Michigan (Barton et al. (2022) and Brus et al. (2022)). The load Love numbers +!! are from Wang et al. (2012), which are in the center of mass of total Earth system reference frame (CM). When used, +!! Love numbers with degree<2 should be converted to center of mass solid Earth reference frame (CF) (Blewitt (2003)), +!! as in subroutine calc_love_scaling in MOM_tidal_forcing module. +!! +!! References: +!! +!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J., +!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a +!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review. +!! +!! Blewitt, G., 2003. Self‐consistency in reference frames, geocenter definition, and surface loading of the solid +!! Earth. Journal of geophysical research: solid earth, 108(B2). +!! https://doi.org/10.1029/2002JB002082 +!! +!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D., +!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean +!! models. Ocean Modelling, in review. +!! +!! Wang, H., Xiang, L., Jia, L., Jiang, L., Wang, Z., Hu, B. and Gao, P., 2012. Load Love numbers and Green's functions +!! for elastic Earth models PREM, iasp91, ak135, and modified models with refined crustal structure from Crust 2.0. +!! Computers & Geosciences, 49, pp.190-199. +!! https://doi.org/10.1016/j.cageo.2012.06.022 +end module MOM_load_love_numbers \ No newline at end of file diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 864669a217..0aef33ddc6 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -48,6 +48,7 @@ module MOM_mixed_layer_restrat logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] real :: MLE_MLD_decay_time !< Time-scale to use in a running-mean when MLD is retreating [T ~> s]. real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating [T ~> s]. real :: MLE_density_diff !< Density difference used in detecting mixed-layer depth [R ~> kg m-3]. @@ -189,6 +190,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var real :: dh ! Portion of the layer thickness that is in the mixed layer [H ~> m or kg m-2] real :: res_scaling_fac ! The resolution-dependent scaling factor [nondim] real :: I_LFront ! The inverse of the frontal length scale [L-1 ~> m-1] + real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times + ! pi squared [nondim] logical :: line_is_empty, keep_going, res_upscale integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -200,6 +203,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var covTS(:)=0.0 !!Functionality not implemented yet; in future, should be passed in tv varS(:)=0.0 + vonKar_x_pi2 = CS%vonKar * 9.8696 + if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") if (.not. allocated(VarMix%Rd_dx_h) .and. CS%front_length > 0.) & @@ -380,25 +385,24 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) - ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 - ! 0.41 is the von Karmen constant, 9.8696 = pi^2. h_vel = 0.5*((htot_fast(i,j) + htot_fast(i+1,j)) + h_neglect) * GV%H_to_Z - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i+1,j)) + h_neglect) * GV%H_to_Z - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml_slow(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) + uDml_slow(I) == 0.) then @@ -456,25 +460,24 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, forces, dt, MLD_in, Var ( sqrt( 0.5 * ( (G%dxCv(i,J))**2 + (G%dyCv(i,J))**2 ) ) * I_LFront ) & * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) - ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 - ! 0.41 is the von Karmen constant, 9.8696 = pi^2. h_vel = 0.5*((htot_fast(i,j) + htot_fast(i,j+1)) + h_neglect) * GV%H_to_Z - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef if (res_upscale) timescale = timescale * res_scaling_fac - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%Z_to_H) ! As above but using the slow filtered MLD h_vel = 0.5*((htot_slow(i,j) + htot_slow(i,j+1)) + h_neglect) * GV%H_to_Z - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 if (res_upscale) timescale = timescale * res_scaling_fac - vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml_slow(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) + vDml_slow(i) == 0.) then @@ -617,6 +620,8 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) real :: h_vel ! htot interpolated onto velocity points [Z ~> m]. (The units are not H.) real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: u_star ! surface friction velocity, interpolated to velocity points [Z T-1 ~> m s-1]. + real :: vonKar_x_pi2 ! A scaling constant that is approximately the von Karman constant times + ! pi squared [nondim] real :: mom_mixrate ! rate at which momentum is homogenized within mixed layer [T-1 ~> s-1] real :: timescale ! mixing growth timescale [T ~> s] real :: h_min ! The minimum layer thickness [H ~> m or kg m-2]. h_min could be 0. @@ -653,6 +658,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) uDml(:) = 0.0 ; vDml(:) = 0.0 I4dt = 0.25 / dt g_Rho0 = GV%g_Earth / GV%Rho0 + vonKar_x_pi2 = CS%vonKar * 9.8696 use_EOS = associated(tv%eqn_of_state) h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_Z @@ -701,17 +707,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 - ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & + uDml(I) = timescale * G%OBCmaskCu(I,j)*G%dyCu(I,j)*G%IdxCu(I,j) * & (Rml_av(i+1,j)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (uDml(I) == 0) then @@ -748,17 +753,16 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) u_star = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) - ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) + ! peak ML visc: u_star * von_Karman * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 - ! 0.41 is the von Karmen constant, 9.8696 = pi^2. - mom_mixrate = (0.41*9.8696)*u_star**2 / & + mom_mixrate = vonKar_x_pi2*u_star**2 / & (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef ! timescale = timescale*(2?)*(L_def/L_MLI) * min(EKE/MKE,1.0 + (G%dyCv(i,j)/L_def)**2) - vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & + vDml(i) = timescale * G%OBCmaskCv(i,J)*G%dxCv(i,J)*G%IdyCv(i,J) * & (Rml_av(i,j+1)-Rml_av(i,j)) * (h_vel**2 * GV%Z_to_H) if (vDml(i) == 0) then do k=1,nkml ; vhml(i,J,k) = 0.0 ; enddo @@ -877,6 +881,9 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_stanley_ml, & "If true, turn on Stanley SGS T variance parameterization "// & "in ML restrat code.", default=.false.) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) ! We use GV%nkml to distinguish between the old and new implementation of MLE. ! The old implementation only works for the layer model with nkml>0. if (GV%nkml==0) then diff --git a/src/parameterizations/lateral/MOM_spherical_harmonics.F90 b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 new file mode 100644 index 0000000000..54b441fa8b --- /dev/null +++ b/src/parameterizations/lateral/MOM_spherical_harmonics.F90 @@ -0,0 +1,382 @@ +!> Laplace's spherical harmonic transforms (SHT) +module MOM_spherical_harmonics +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, & + CLOCK_MODULE, CLOCK_ROUTINE, CLOCK_LOOP +use MOM_error_handler, only : MOM_error, FATAL +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_coms_infra, only : sum_across_PEs +use MOM_coms, only : reproducing_sum + +implicit none ; private + +public spherical_harmonics_init, spherical_harmonics_end, order2index, calc_lmax +public spherical_harmonics_forward, spherical_harmonics_inverse + +#include + +!> Control structure for spherical harmonic transforms +type, public :: sht_CS ; private + logical :: initialized = .False. !< True if this control structure has been initialized. + integer :: ndegree !< Maximum degree of the spherical harmonics [nodim]. + integer :: lmax !< Number of associated Legendre polynomials of nonnegative m + !! [lmax=(ndegree+1)*(ndegree+2)/2] [nodim]. + real, allocatable :: cos_clatT(:,:) !< Precomputed cosine of colatitude at the t-cells [nondim]. + real, allocatable :: Pmm(:,:,:) !< Precomputed associated Legendre polynomials (m=n) at the t-cells [nondim]. + real, allocatable :: cos_lonT(:,:,:), & !< Precomputed cosine factors at the t-cells [nondim]. + sin_lonT(:,:,:) !< Precomputed sine factors at the t-cells [nondim]. + real, allocatable :: cos_lonT_wtd(:,:,:), & !< Precomputed area-weighted cosine factors at the t-cells [nondim] + sin_lonT_wtd(:,:,:) !< Precomputed area-weighted sine factors at the t-cells [nondim] + real, allocatable :: a_recur(:,:), & !< Precomputed recurrence coefficients a [nondim]. + b_recur(:,:) !< Precomputed recurrence coefficients b [nondim]. + real, allocatable :: Snm_Re_raw(:,:,:), & !< Array to store un-summed SHT coefficients + Snm_Im_raw(:,:,:) !< at the t-cells for reproducing sums [same as input variable] + logical :: reprod_sum !< True if use reproducible global sums +end type sht_CS + +integer :: id_clock_sht=-1 !< CPU clock for SHT [MODULE] +integer :: id_clock_sht_forward=-1 !< CPU clock for forward transforms [ROUTINE] +integer :: id_clock_sht_inverse=-1 !< CPU clock for inverse transforms [ROUTINE] +integer :: id_clock_sht_global_sum=-1 !< CPU clock for global summation in forward transforms [LOOP] + +contains + +!> Calculates forward spherical harmonics transforms +subroutine spherical_harmonics_forward(G, CS, var, Snm_Re, Snm_Im, Nd) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(sht_CS), intent(inout) :: CS !< Control structure for SHT + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: var !< Input 2-D variable [] + real, intent(out) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) + real, intent(out) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics + !! overriding ndegree in the CS [nondim] + ! local variables + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] + integer :: Ltot ! Local copy of the number of spherical harmonics [nodim] + real, dimension(SZI_(G),SZJ_(G)) :: & + pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + integer :: i, j, k + integer :: is, ie, js, je, isd, ied, jsd, jed + integer :: m, n, l + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_spherical_harmonics " // & + "spherical_harmonics_forward: Module must be initialized before it is used.") + + if (id_clock_sht>0) call cpu_clock_begin(id_clock_sht) + if (id_clock_sht_forward>0) call cpu_clock_begin(id_clock_sht_forward) + + Nmax = CS%ndegree; if (present(Nd)) Nmax = Nd + Ltot = calc_lmax(Nmax) + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + do j=jsd,jed ; do i=isd,ied + pmn(i,j) = 0.0; pmnm1(i,j) = 0.0; pmnm2(i,j) = 0.0 + enddo ; enddo + + do l=1,Ltot ; Snm_Re(l) = 0.0; Snm_Im(l) = 0.0 ; enddo + + if (CS%reprod_sum) then + do m=0,Nmax + l = order2index(m, Nmax) + + do j=js,je ; do i=is,ie + CS%Snm_Re_raw(i,j,l) = var(i,j) * CS%Pmm(i,j,m+1) * CS%cos_lonT_wtd(i,j,m+1) + CS%Snm_Im_raw(i,j,l) = var(i,j) * CS%Pmm(i,j,m+1) * CS%sin_lonT_wtd(i,j,m+1) + pmnm2(i,j) = 0.0 + pmnm1(i,j) = CS%Pmm(i,j,m+1) + enddo ; enddo + + do n = m+1, Nmax ; do j=js,je ; do i=is,ie + pmn(i,j) = & + CS%a_recur(n+1,m+1) * CS%cos_clatT(i,j) * pmnm1(i,j) - CS%b_recur(n+1,m+1) * pmnm2(i,j) + CS%Snm_Re_raw(i,j,l+n-m) = var(i,j) * pmn(i,j) * CS%cos_lonT_wtd(i,j,m+1) + CS%Snm_Im_raw(i,j,l+n-m) = var(i,j) * pmn(i,j) * CS%sin_lonT_wtd(i,j,m+1) + pmnm2(i,j) = pmnm1(i,j) + pmnm1(i,j) = pmn(i,j) + enddo ; enddo ; enddo + enddo + else + do m=0,Nmax + l = order2index(m, Nmax) + + do j=js,je ; do i=is,ie + Snm_Re(l) = Snm_Re(l) + var(i,j) * CS%Pmm(i,j,m+1) * CS%cos_lonT_wtd(i,j,m+1) + Snm_Im(l) = Snm_Im(l) + var(i,j) * CS%Pmm(i,j,m+1) * CS%sin_lonT_wtd(i,j,m+1) + pmnm2(i,j) = 0.0 + pmnm1(i,j) = CS%Pmm(i,j,m+1) + enddo ; enddo + + do n=m+1, Nmax ; do j=js,je ; do i=is,ie + pmn(i,j) = & + CS%a_recur(n+1,m+1) * CS%cos_clatT(i,j) * pmnm1(i,j) - CS%b_recur(n+1,m+1) * pmnm2(i,j) + Snm_Re(l+n-m) = Snm_Re(l+n-m) + var(i,j) * pmn(i,j) * CS%cos_lonT_wtd(i,j,m+1) + Snm_Im(l+n-m) = Snm_Im(l+n-m) + var(i,j) * pmn(i,j) * CS%sin_lonT_wtd(i,j,m+1) + pmnm2(i,j) = pmnm1(i,j) + pmnm1(i,j) = pmn(i,j) + enddo ; enddo ; enddo + enddo + endif + + if (id_clock_sht_global_sum>0) call cpu_clock_begin(id_clock_sht_global_sum) + + if (CS%reprod_sum) then + do l=1,Ltot + Snm_Re(l) = reproducing_sum(CS%Snm_Re_raw(:,:,l)) + Snm_Im(l) = reproducing_sum(CS%Snm_Im_raw(:,:,l)) + enddo + else + call sum_across_PEs(Snm_Re, Ltot) + call sum_across_PEs(Snm_Im, Ltot) + endif + + if (id_clock_sht_global_sum>0) call cpu_clock_end(id_clock_sht_global_sum) + if (id_clock_sht_forward>0) call cpu_clock_end(id_clock_sht_forward) + if (id_clock_sht>0) call cpu_clock_end(id_clock_sht) +end subroutine spherical_harmonics_forward + +!> Calculates inverse spherical harmonics transforms +subroutine spherical_harmonics_inverse(G, CS, Snm_Re, Snm_Im, var, Nd) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(sht_CS), intent(in) :: CS !< Control structure for SHT + real, intent(in) :: Snm_Re(:) !< SHT coefficients for the real modes (cosine) + real, intent(in) :: Snm_Im(:) !< SHT coefficients for the imaginary modes (sine) + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: var !< Output 2-D variable [] + integer, optional, intent(in) :: Nd !< Maximum degree of the spherical harmonics + !! overriding ndegree in the CS [nondim] + ! local variables + integer :: Nmax ! Local copy of the maximum degree of the spherical harmonics [nodim] + real :: mFac ! A constant multiplier. mFac = 1 (if m==0) or 2 (if m>0) [nodim] + real, dimension(SZI_(G),SZJ_(G)) :: & + pmn, & ! Current associated Legendre polynomials of degree n and order m [nodim] + pmnm1, & ! Associated Legendre polynomials of degree n-1 and order m [nodim] + pmnm2 ! Associated Legendre polynomials of degree n-2 and order m [nodim] + integer :: i, j, k + integer :: is, ie, js, je, isd, ied, jsd, jed + integer :: m, n, l + + if (.not.CS%initialized) call MOM_error(FATAL, "MOM_spherical_harmonics " // & + "spherical_harmonics_inverse: Module must be initialized before it is used.") + + if (id_clock_sht>0) call cpu_clock_begin(id_clock_sht) + if (id_clock_sht_inverse>0) call cpu_clock_begin(id_clock_sht_inverse) + + Nmax = CS%ndegree; if (present(Nd)) Nmax = Nd + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + do j=jsd,jed ; do i=isd,ied + pmn(i,j) = 0.0; pmnm1(i,j) = 0.0; pmnm2(i,j) = 0.0 + var(i,j) = 0.0 + enddo ; enddo + + do m=0,Nmax + mFac = sign(1.0, m-0.5)*0.5 + 1.5 + l = order2index(m, Nmax) + + do j=js,je ; do i=is,ie + var(i,j) = var(i,j) & + + mFac * CS%Pmm(i,j,m+1) * ( Snm_Re(l) * CS%cos_lonT(i,j,m+1) & + + Snm_Im(l) * CS%sin_lonT(i,j,m+1)) + pmnm2(i,j) = 0.0 + pmnm1(i,j) = CS%Pmm(i,j,m+1) + enddo ; enddo + + do n=m+1,Nmax ; do j=js,je ; do i=is,ie + pmn(i,j) = & + CS%a_recur(n+1,m+1) * CS%cos_clatT(i,j) * pmnm1(i,j) - CS%b_recur(n+1,m+1) * pmnm2(i,j) + var(i,j) = var(i,j) & + + mFac * pmn(i,j) * ( Snm_Re(l+n-m) * CS%cos_lonT(i,j,m+1) & + + Snm_Im(l+n-m) * CS%sin_lonT(i,j,m+1)) + pmnm2(i,j) = pmnm1(i,j) + pmnm1(i,j) = pmn(i,j) + enddo ; enddo ; enddo + enddo + + if (id_clock_sht_inverse>0) call cpu_clock_end(id_clock_sht_inverse) + if (id_clock_sht>0) call cpu_clock_end(id_clock_sht) +end subroutine spherical_harmonics_inverse + +!> Calculate precomputed coefficients +subroutine spherical_harmonics_init(G, param_file, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure indicating + type(sht_CS), intent(inout) :: CS !< Control structure for spherical harmonic transforms + + ! local variables + real, parameter :: PI = 4.0*atan(1.0) ! 3.1415926... calculated as 4*atan(1) [nodim] + real, parameter :: RADIAN = PI / 180.0 ! Degree to Radian constant [rad/degree] + real, dimension(SZI_(G),SZJ_(G)) :: sin_clatT ! sine of colatitude at the t-cells [nondim]. + real :: Pmm_coef ! = sqrt{ 1.0/(4.0*PI) * prod[(2k+1)/2k)] } [nondim]. + integer :: is, ie, js, je + integer :: i, j, k + integer :: m, n + integer :: Nd_tidal_SAL ! Maximum degree for tidal SAL + ! This include declares and sets the variable "version". +# include "version_variable.h" + character(len=40) :: mdl = "MOM_spherical_harmonics" ! This module's name. + + if (CS%initialized) return + CS%initialized = .True. + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", Nd_tidal_SAL, & + "The maximum degree of the spherical harmonics transformation used for "// & + "calculating the self-attraction and loading term for tides.", & + default=0, do_not_log=.true.) + CS%ndegree = Nd_tidal_SAL + CS%lmax = calc_lmax(CS%ndegree) + call get_param(param_file, mdl, "SHT_REPRODUCING_SUM", CS%reprod_sum, & + "If true, use reproducing sums (invariant to PE layout) in inverse transform "// & + "of spherical harmonics. Otherwise use a simple sum of floating point numbers. ", & + default=.False.) + + ! Calculate recurrence relationship coefficients + allocate(CS%a_recur(CS%ndegree+1, CS%ndegree+1)); CS%a_recur(:,:) = 0.0 + allocate(CS%b_recur(CS%ndegree+1, CS%ndegree+1)); CS%b_recur(:,:) = 0.0 + do m=0,CS%ndegree ; do n=m+1,CS%ndegree + CS%a_recur(n+1,m+1) = sqrt(real((2*n-1) * (2*n+1)) / real((n-m) * (n+m))) + CS%b_recur(n+1,m+1) = sqrt(real((2*n+1) * (n+m-1) * (n-m-1)) / real((n-m) * (n+m) * (2*n-3))) + enddo ; enddo + + ! Calculate complex exponential factors + allocate(CS%cos_lonT_wtd(is:ie, js:je, CS%ndegree+1)); CS%cos_lonT_wtd(:,:,:) = 0.0 + allocate(CS%sin_lonT_wtd(is:ie, js:je, CS%ndegree+1)); CS%sin_lonT_wtd(:,:,:) = 0.0 + allocate(CS%cos_lonT(is:ie, js:je, CS%ndegree+1)); CS%cos_lonT(:,:,:) = 0.0 + allocate(CS%sin_lonT(is:ie, js:je, CS%ndegree+1)); CS%sin_lonT(:,:,:) = 0.0 + do m=0,CS%ndegree + do j=js,je ; do i=is,ie + CS%cos_lonT(i,j,m+1) = cos(real(m) * (G%geolonT(i,j)*RADIAN)) + CS%sin_lonT(i,j,m+1) = sin(real(m) * (G%geolonT(i,j)*RADIAN)) + CS%cos_lonT_wtd(i,j,m+1) = CS%cos_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth**2 + CS%sin_lonT_wtd(i,j,m+1) = CS%sin_lonT(i,j,m+1) * G%areaT(i,j) / G%Rad_Earth**2 + enddo ; enddo + enddo + + ! Calculate sine and cosine of colatitude + allocate(CS%cos_clatT(is:ie, js:je)); CS%cos_clatT(:,:) = 0.0 + do j=js,je ; do i=is,ie + CS%cos_clatT(i,j) = cos(0.5*PI - G%geolatT(i,j)*RADIAN) + sin_clatT(i,j) = sin(0.5*PI - G%geolatT(i,j)*RADIAN) + enddo ; enddo + + ! Calculate the diagonal elements of the associated Legendre polynomials (n=m) + allocate(CS%Pmm(is:ie,js:je,m+1)); CS%Pmm(:,:,:) = 0.0 + do m=0,CS%ndegree + Pmm_coef = 1.0/(4.0*PI) + do k=1,m ; Pmm_coef = Pmm_coef * (real(2*k+1) / real(2*k)); enddo + Pmm_coef = sqrt(Pmm_coef) + do j=js,je ; do i=is,ie + CS%Pmm(i,j,m+1) = Pmm_coef * (sin_clatT(i,j)**m) + enddo ; enddo + enddo + + if (CS%reprod_sum) then + allocate(CS%Snm_Re_raw(is:ie, js:je, CS%lmax)); CS%Snm_Re_raw = 0.0 + allocate(CS%Snm_Im_raw(is:ie, js:je, CS%lmax)); CS%Snm_Im_raw = 0.0 + endif + + id_clock_sht = cpu_clock_id('(Ocean spherical harmonics)', grain=CLOCK_MODULE) + id_clock_sht_forward = cpu_clock_id('(Ocean SHT forward)', grain=CLOCK_ROUTINE) + id_clock_sht_inverse = cpu_clock_id('(Ocean SHT inverse)', grain=CLOCK_ROUTINE) + id_clock_sht_global_sum = cpu_clock_id('(Ocean SHT global sum)', grain=CLOCK_LOOP) + +end subroutine spherical_harmonics_init + +!> Deallocate any variables allocated in spherical_harmonics_init +subroutine spherical_harmonics_end(CS) + type(sht_CS), intent(inout) :: CS !< Control structure for spherical harmonic transforms + + deallocate(CS%cos_clatT) + deallocate(CS%Pmm) + deallocate(CS%cos_lonT_wtd, CS%sin_lonT_wtd, CS%cos_lonT, CS%sin_lonT) + deallocate(CS%a_recur, CS%b_recur) + if (CS%reprod_sum) & + deallocate(CS%Snm_Re_raw, CS%Snm_Im_raw) +end subroutine spherical_harmonics_end + +!> Calculates the number of real elements (cosine) of spherical harmonics given maximum degree Nd. +function calc_lmax(Nd) result(lmax) + integer :: lmax !< Number of real spherical harmonic modes [nodim] + integer, intent(in) :: Nd !< Maximum degree [nodim] + + lmax = (Nd+2) * (Nd+1) / 2 +end function calc_lmax + +!> Calculates the one-dimensional index number at (n=0, m=m), given order m and maximum degree Nd. +!! It is sequenced with degree (n) changing first and order (m) changing second. +function order2index(m, Nd) result(l) + integer :: l !< One-dimensional index number [nodim] + integer, intent(in) :: m !< Current order number [nodim] + integer, intent(in) :: Nd !< Maximum degree [nodim] + + l = ((Nd+1) + (Nd+1-(m-1)))*m/2 + 1 +end function order2index + +!> \namespace mom_spherical_harmonics +!! +!! This module contains the subroutines to calculate spherical harmonic transforms (SHT), namely, forward transform +!! of a two-dimensional field into a given number of spherical harmonic modes and its inverse transform. This module +!! is primarily used to but not limited to calculate self-attraction and loading (SAL) term, which is mostly relevant to +!! high frequency motions such as tides. Should other needs arise in the future, this API can be easily modified. +!! Currently, the transforms are for t-cell fields only. +!! +!! This module is stemmed from SAL calculation in Model for Prediction Across Scales (MPAS)-Ocean developed by Los +!! Alamos National Laboratory and University of Michigan (Barton et al. (2022) and Brus et al. (2022)). The algorithm +!! for forward and inverse transforms loosely follows Schaeffer (2013). +!! +!! In forward transform, a two-dimensional physical field can be projected into a series of spherical harmonics. The +!! spherical harmonic coefficient of degree n and order m for a field \f$f(\theta, \phi)\f$ is calculated as follows: +!! \f[ +!! f^m_n = \int^{2\pi}_{0}\int^{\pi}_{0}f(\theta,\phi)Y^m_n(\theta,\phi)\sin\theta d\theta d\phi +!! \f] +!! and +!! \f[ +!! Y^m_n(\theta,\phi) = P^m_n(\cos\theta)\exp(im\phi) +!! \f] +!! where \f$P^m_n(\cos \theta)\f$ is the normalized associated Legendre polynomial of degree n and order m. \f$\phi\f$ +!! is the longitude and \f$\theta\f$ is the colatitude. +!! Or, written in the discretized form: +!! \f[ +!! f^m_n = \sum^{Nj}_{0}\sum^{Ni}_{0}f(i,j)Y^m_n(i,j)A(i,j)/r_e^2 +!! \f] +!! where $A$ is the area of the cell and $r_e$ is the radius of the Earth. +!! +!! In inverse transform, the first N degree spherical harmonic coefficients are used to reconstruct a two-dimensional +!! physical field: +!! \f[ +!! f(\theta,\phi) = \sum^N_{n=0}\sum^{n}_{m=-n}f^m_nY^m_n(\theta,\phi) +!! \f] +!! +!! The exponential coefficients are pre-computed and stored in the memory. The associated Legendre polynomials are +!! computed "on-the-fly", using the recurrence relationships to avoid large memory usage and take the advantage of +!! array vectorization. +!! +!! The maximum degree of the spherical harmonics is a runtime parameter and the maximum used by all SHT applications. +!! At the moment, it is only decided by TIDAL_SAL_SHT_DEGREE. +!! +!! The forward transforms involve a global summation. Runtime flag SHT_REPRODUCING_SUM controls whether this is done +!! in a bit-wise reproducing way or not. +!! +!! References: +!! +!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J., +!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a +!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review. +!! +!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D., +!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean +!! models. Ocean Modelling, in review. +!! +!! Schaeffer, N., 2013. Efficient spherical harmonic transforms aimed at pseudospectral numerical simulations. +!! Geochemistry, Geophysics, Geosystems, 14(3), pp.751-758. +!! https://doi.org/10.1002/ggge.20071 +end module MOM_spherical_harmonics \ No newline at end of file diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index 3cab1030da..c7310e1560 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -233,7 +233,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%MEKE_GEOMETRIC) then !$OMP do do j=js,je ; do I=is-1,ie - Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%mask2dCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & + Khth_loc_u(I,j) = Khth_loc_u(I,j) + G%OBCmaskCu(I,j) * CS%MEKE_GEOMETRIC_alpha * & 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i+1,j)) / & (VarMix%SN_u(I,j) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo @@ -319,7 +319,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, US, MEKE, VarMix, CDp if (CS%MEKE_GEOMETRIC) then !$OMP do do J=js-1,je ; do i=is,ie - Khth_loc_v(i,J) = Khth_loc_v(i,J) + G%mask2dCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & + Khth_loc_v(i,J) = Khth_loc_v(i,J) + G%OBCmaskCv(i,J) * CS%MEKE_GEOMETRIC_alpha * & 0.5*(MEKE%MEKE(i,j)+MEKE%MEKE(i,j+1)) / & (VarMix%SN_v(i,J) + CS%MEKE_GEOMETRIC_epsilon) enddo ; enddo @@ -956,7 +956,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_x) then Slope = slope_x(I,j,k) else - Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%mask2dCu(I,j) + Slope = ((e(i,j,K)-e(i+1,j,K))*G%IdxCu(I,j)) * G%OBCmaskCu(I,j) endif if (CS%id_slope_x > 0) CS%diagSlopeX(I,j,k) = Slope Sfn_unlim_u(I,K) = ((KH_u(I,j,K)*G%dy_Cu(I,j))*Slope) @@ -971,7 +971,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! k-loop if (CS%use_FGNV_streamfn) then - do k=1,nz ; do I=is-1,ie ; if (G%mask2dCu(I,j)>0.) then + do k=1,nz ; do I=is-1,ie ; if (G%OBCmaskCu(I,j)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i+1,j,k) / ( ( h(i,j,k) + h(i+1,j,k) ) + h_neglect ) ) c2_h_u(I,k) = CS%FGNV_scale * & @@ -980,7 +980,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do I=is-1,ie - if (G%mask2dCu(I,j)>0.) then + if (G%OBCmaskCu(I,j)>0.) then do K=2,nz Sfn_unlim_u(I,K) = (1. + CS%FGNV_scale) * Sfn_unlim_u(I,K) enddo @@ -1238,7 +1238,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV if (present_slope_y) then Slope = slope_y(i,J,k) else - Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%mask2dCv(i,J) + Slope = ((e(i,j,K)-e(i,j+1,K))*G%IdyCv(i,J)) * G%OBCmaskCv(i,J) endif if (CS%id_slope_y > 0) CS%diagSlopeY(I,j,k) = Slope Sfn_unlim_v(i,K) = ((KH_v(i,J,K)*G%dx_Cv(i,J))*Slope) @@ -1253,7 +1253,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV enddo ! k-loop if (CS%use_FGNV_streamfn) then - do k=1,nz ; do i=is,ie ; if (G%mask2dCv(i,J)>0.) then + do k=1,nz ; do i=is,ie ; if (G%OBCmaskCv(i,J)>0.) then h_harm = max( h_neglect, & 2. * h(i,j,k) * h(i,j+1,k) / ( ( h(i,j,k) + h(i,j+1,k) ) + h_neglect ) ) c2_h_v(i,k) = CS%FGNV_scale * & @@ -1262,7 +1262,7 @@ subroutine thickness_diffuse_full(h, e, Kh_u, Kh_v, tv, uhD, vhD, cg1, dt, G, GV ! Solve an elliptic equation for the streamfunction following Ferrari et al., 2010. do i=is,ie - if (G%mask2dCv(i,J)>0.) then + if (G%OBCmaskCv(i,J)>0.) then do K=2,nz Sfn_unlim_v(i,K) = (1. + CS%FGNV_scale) * Sfn_unlim_v(i,K) enddo @@ -1651,7 +1651,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV de_bot(i,j) = de_bot(i,j) + h(i,j,k+1) enddo ; enddo - do j=js,je ; do I=is-1,ie ; if (G%mask2dCu(I,j) > 0.0) then + do j=js,je ; do I=is-1,ie ; if (G%OBCmaskCu(I,j) > 0.0) then if (h(i,j,k) > h(i+1,j,k)) then h2 = h(i,j,k) h1 = max( h(i+1,j,k), h2 - min(de_bot(i+1,j), de_top(i+1,j,k)) ) @@ -1663,7 +1663,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV KH_lay_u(I,j,k) = (Kh_scale * KH_u_CFL(I,j)) * jag_Rat**2 endif ; enddo ; enddo - do J=js-1,je ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + do J=js-1,je ; do i=is,ie ; if (G%OBCmaskCv(i,J) > 0.0) then if (h(i,j,k) > h(i,j+1,k)) then h2 = h(i,j,k) h1 = max( h(i,j+1,k), h2 - min(de_bot(i,j+1), de_top(i,j+1,k)) ) @@ -1689,7 +1689,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV ! First, populate the diffusivities if (n==1) then ! This is a u-column. do i=ish,ie - do_i(I) = (G%mask2dCu(I,j) > 0.0) + do_i(I) = (G%OBCmaskCu(I,j) > 0.0) Kh_Max_max(I) = KH_u_CFL(I,j) enddo do K=1,nz+1 ; do i=ish,ie @@ -1699,7 +1699,7 @@ subroutine add_detangling_Kh(h, e, Kh_u, Kh_v, KH_u_CFL, KH_v_CFL, tv, dt, G, GV enddo ; enddo else ! This is a v-column. do i=ish,ie - do_i(i) = (G%mask2dCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) + do_i(i) = (G%OBCmaskCv(i,J) > 0.0) ; Kh_Max_max(I) = KH_v_CFL(i,J) enddo do K=1,nz+1 ; do i=ish,ie Kh_bg(I,K) = KH_v(I,j,K) ; Kh(I,K) = Kh_bg(I,K) @@ -2003,11 +2003,11 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) allocate(CS%Kh_eta_v(G%isd:G%ied, G%JsdB:G%JedB), source=0.) do j=G%jsc,G%jec ; do I=G%isc-1,G%iec grid_sp = sqrt((2.0*G%dxCu(I,j)**2 * G%dyCu(I,j)**2) / (G%dxCu(I,j)**2 + G%dyCu(I,j)**2)) - CS%Kh_eta_u(I,j) = G%mask2dCu(I,j) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp) + CS%Kh_eta_u(I,j) = G%OBCmaskCu(I,j) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp) enddo ; enddo do J=G%jsc-1,G%jec ; do i=G%isc,G%iec grid_sp = sqrt((2.0*G%dxCv(i,J)**2 * G%dyCv(i,J)**2) / (G%dxCv(i,J)**2 + G%dyCv(i,J)**2)) - CS%Kh_eta_v(i,J) = G%mask2dCv(i,J) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp) + CS%Kh_eta_v(i,J) = G%OBCmaskCv(i,J) * MAX(0.0, CS%Kh_eta_bg + CS%Kh_eta_vel * grid_sp) enddo ; enddo endif diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index b8a9b3134c..dcf12f915f 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -4,7 +4,7 @@ module MOM_tidal_forcing ! This file is part of MOM6. See LICENSE.md for the license. use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, & - CLOCK_MODULE + CLOCK_MODULE, CLOCK_ROUTINE use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING use MOM_file_parser, only : get_param, log_version, param_file_type @@ -12,6 +12,10 @@ module MOM_tidal_forcing use MOM_io, only : field_exists, file_exists, MOM_read_data use MOM_time_manager, only : set_date, time_type, time_type_to_real, operator(-) use MOM_unit_scaling, only : unit_scale_type +use MOM_spherical_harmonics, only : spherical_harmonics_init, spherical_harmonics_end, order2index, calc_lmax +use MOM_spherical_harmonics, only : spherical_harmonics_forward, spherical_harmonics_inverse +use MOM_spherical_harmonics, only : sht_CS +use MOM_load_love_numbers, only : Love_Data implicit none ; private @@ -46,6 +50,7 @@ module MOM_tidal_forcing !! equilibrium tide. Set to false if providing tidal phases !! that have already been shifted by the !! astronomical/equilibrium argument. + logical :: tidal_sal_sht !< If true, use online spherical harmonics to calculate SAL real :: sal_scalar !< The constant of proportionality between sea surface !! height (really it should be bottom pressure) anomalies !! and bottom geopotential anomalies [nondim]. @@ -70,9 +75,15 @@ module MOM_tidal_forcing cosphase_prev(:,:,:), & !< The cosine and sine of the phase of the sinphase_prev(:,:,:), & !< amphidromes in the previous tidal solutions. amp_prev(:,:,:) !< The amplitude of the previous tidal solution [Z ~> m]. + type(sht_CS) :: sht !< Spherical harmonic transforms (SHT) for SAL + integer :: sal_sht_Nd !< Maximum degree for SHT [nodim] + real, allocatable :: Love_Scaling(:) !< Love number for each SHT mode [nodim] + real, allocatable :: Snm_Re(:), & !< Real and imaginary SHT coefficient for SHT SAL + Snm_Im(:) !< [Z ~> m] end type tidal_forcing_CS integer :: id_clock_tides !< CPU clock for tides +integer :: id_clock_SAL !< CPU clock for self-attraction and loading contains @@ -255,6 +266,10 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) character(len=128) :: mesg character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS) integer :: i, j, c, is, ie, js, je, isd, ied, jsd, jed, nc + integer :: lmax ! Total modes of the real spherical harmonics [nondim] + real :: rhoW ! The average density of sea water [R ~> kg m-3]. + real :: rhoE ! The average density of Earth [R ~> kg m-3]. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd; jed = G%jed @@ -360,6 +375,10 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) "TIDES and TIDE_USE_SAL_SCALAR are true.", units="m m-1", & fail_if_missing=.true.) + call get_param(param_file, mdl, "TIDAL_SAL_SHT", CS%tidal_sal_sht, & + "If true, use the online spherical harmonics method to calculate "//& + "self-attraction and loading term in tides.", default=.false.) + if (nc > MAX_CONSTITUENTS) then write(mesg,'("Increase MAX_CONSTITUENTS in MOM_tidal_forcing.F90 to at least",I3, & &"to accommodate all the registered tidal constituents.")') nc @@ -519,10 +538,73 @@ subroutine tidal_forcing_init(Time, G, US, param_file, CS) enddo endif + if (CS%tidal_sal_sht) then + call get_param(param_file, mdl, "TIDAL_SAL_SHT_DEGREE", CS%sal_sht_Nd, & + "The maximum degree of the spherical harmonics transformation used for "// & + "calculating the self-attraction and loading term for tides.", & + default=0, do_not_log=.not. CS%tidal_sal_sht) + call get_param(param_file, mdl, "RHO_0", rhoW, & + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& + "parameters from vertical units of m to kg m-2.", & + units="kg m-3", default=1035.0, scale=US%kg_m3_to_R, do_not_log=.True.) + call get_param(param_file, mdl, "RHO_E", rhoE, & + "The mean solid earth density. This is used for calculating the "// & + "self-attraction and loading term.", units="kg m-3", & + default=5517.0, scale=US%kg_m3_to_R, do_not_log=.not. CS%tidal_sal_sht) + lmax = calc_lmax(CS%sal_sht_Nd) + allocate(CS%Snm_Re(lmax)); CS%Snm_Re(:) = 0.0 + allocate(CS%Snm_Im(lmax)); CS%Snm_Im(:) = 0.0 + + allocate(CS%Love_Scaling(lmax)); CS%Love_Scaling(:) = 0.0 + call calc_love_scaling(CS%sal_sht_Nd, rhoW, rhoE, CS%Love_Scaling) + call spherical_harmonics_init(G, param_file, CS%sht) + id_clock_SAL = cpu_clock_id('(Ocean SAL)', grain=CLOCK_ROUTINE) + endif + id_clock_tides = cpu_clock_id('(Ocean tides)', grain=CLOCK_MODULE) end subroutine tidal_forcing_init +!> This subroutine calculates coefficients of the spherical harmonic modes for self-attraction and loading. +!! The algorithm is based on the SAL implementation in MPAS-ocean, which was modified by Kristin Barton from +!! routine written by K. Quinn (March 2010) and modified by M. Schindelegger (May 2017). +subroutine calc_love_scaling(nlm, rhoW, rhoE, Love_Scaling) + integer, intent(in) :: nlm !< Maximum spherical harmonics degree [nondim] + real, intent(in) :: rhoW !< The average density of sea water [R ~> kg m-3] + real, intent(in) :: rhoE !< The average density of Earth [R ~> kg m-3] + real, dimension(:), intent(out) :: Love_Scaling !< Scaling factors for inverse SHT [nondim] + + ! Local variables + real, dimension(:), allocatable :: HDat, LDat, KDat ! Love numbers converted in CF reference frames + real :: H1, L1, K1 ! Temporary variables to store degree 1 Love numbers + integer :: n_tot ! Size of the stored Love numbers + integer :: n, m, l + + n_tot = size(Love_Data, dim=2) + + if (nlm+1 > n_tot) call MOM_error(FATAL, "MOM_tidal_forcing " // & + "calc_love_scaling: maximum spherical harmonics degree is larger than " // & + "the size of the stored Love numbers in MOM_load_love_number.") + + allocate(HDat(nlm+1), LDat(nlm+1), KDat(nlm+1)) + HDat(:) = Love_Data(2,1:nlm+1) ; LDat(:) = Love_Data(3,1:nlm+1) ; KDat(:) = Love_Data(4,1:nlm+1) + + ! Convert reference frames from CM to CF + if (nlm > 0) then + H1 = HDat(2) ; L1 = LDat(2) ; K1 = KDat(2) + HDat(2) = ( 2.0 / 3.0) * (H1 - L1) + LDat(2) = (-1.0 / 3.0) * (H1 - L1) + KDat(2) = (-1.0 / 3.0) * H1 - (2.0 / 3.0) * L1 - 1.0 + endif + + do m=0,nlm ; do n=m,nlm + l = order2index(m,nlm) + Love_Scaling(l+n-m) = (3.0 / real(2*n+1)) * (rhoW / rhoE) * (1.0 + KDat(n+1) - HDat(n+1)) + enddo ; enddo +end subroutine calc_love_scaling + !> This subroutine finds a named variable in a list of files and reads its !! values into a domain-decomposed 2-d array subroutine find_in_files(filenames, varname, array, G, scale) @@ -587,10 +669,11 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential height !! anomalies [Z ~> m]. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(tidal_forcing_CS), intent(in) :: CS !< The control structure returned by a + type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a !! previous call to tidal_forcing_init. ! Local variables + real, dimension(SZI_(G),SZJ_(G)) :: eta_sal !< SAL calculated by spherical harmonics real :: now ! The relative time compared with the tidal reference [T ~> s] real :: amp_cosomegat, amp_sinomegat ! The tidal amplitudes times the components of phase [Z ~> m] real :: cosomegat, sinomegat ! The components of the phase [nondim] @@ -648,10 +731,50 @@ subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, US, CS) enddo ; enddo enddo ; endif + if (CS%tidal_sal_sht) then + eta_sal(:,:) = 0.0 + call calc_SAL_sht(eta, eta_sal, G, CS) + + do j=Jsq,Jeq+1 ; do i=Isq,Ieq+1 + eta_tidal(i,j) = eta_tidal(i,j) + eta_sal(i,j) + enddo ; enddo + endif call cpu_clock_end(id_clock_tides) end subroutine calc_tidal_forcing +!> This subroutine calculates self-attraction and loading using the spherical harmonics method. +subroutine calc_SAL_sht(eta, eta_sal, G, CS) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from + !! a time-mean geoid [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_sal !< The sea surface height anomaly from + !! self-attraction and loading [Z ~> m]. + type(tidal_forcing_CS), intent(inout) :: CS !< Tidal forcing control struct + + ! Local variables + integer :: n, m, l + + call cpu_clock_begin(id_clock_SAL) + + call spherical_harmonics_forward(G, CS%sht, eta, CS%Snm_Re, CS%Snm_Im, CS%sal_sht_Nd) + + ! Multiply scaling factors to each mode + do m = 0,CS%sal_sht_Nd + l = order2index(m, CS%sal_sht_Nd) + do n = m,CS%sal_sht_Nd + CS%Snm_Re(l+n-m) = CS%Snm_Re(l+n-m) * CS%Love_Scaling(l+n-m) + CS%Snm_Im(l+n-m) = CS%Snm_Im(l+n-m) * CS%Love_Scaling(l+n-m) + enddo + enddo + + call spherical_harmonics_inverse(G, CS%sht, CS%Snm_Re, CS%Snm_Im, eta_sal, CS%sal_sht_Nd) + + call pass_var(eta_sal, G%domain) + + call cpu_clock_end(id_clock_SAL) +end subroutine calc_SAL_sht + !> This subroutine deallocates memory associated with the tidal forcing module. subroutine tidal_forcing_end(CS) type(tidal_forcing_CS), intent(inout) :: CS !< The control structure returned by a previous call @@ -667,6 +790,13 @@ subroutine tidal_forcing_end(CS) if (allocated(CS%cosphase_prev)) deallocate(CS%cosphase_prev) if (allocated(CS%sinphase_prev)) deallocate(CS%sinphase_prev) if (allocated(CS%amp_prev)) deallocate(CS%amp_prev) + + if (CS%tidal_sal_sht) then + if (allocated(CS%Love_Scaling)) deallocate(CS%Love_Scaling) + if (allocated(CS%Snm_Re)) deallocate(CS%Snm_Re) + if (allocated(CS%Snm_Im)) deallocate(CS%Snm_Im) + call spherical_harmonics_end(CS%sht) + endif end subroutine tidal_forcing_end !> \namespace tidal_forcing @@ -697,5 +827,18 @@ end subroutine tidal_forcing_end !! details, see Arbic et al., 2004, DSR II). With TIDAL_SAL_FROM_FILE !! or USE_PREVIOUS_TIDES,a list of input files must be provided to !! describe each constituent's properties from a previous solution. - +!! +!! This module also contains a method to calculate self-attraction +!! and loading using spherical harmonic transforms. The algorithm is +!! based on SAL calculation in Model for Prediction Across Scales +!! (MPAS)-Ocean developed by Los Alamos National Laboratory and +!! University of Michigan (Barton et al. (2022) and Brus et al. (2022)). +!! +!! Barton, K.N., Nairita, P., Brus, S.R., Petersen, M.R., Arbic, B.K., Engwirda, D., Roberts, A.F., Westerink, J., +!! Wirasaet, D., and Schindelegger, M., 2022: Performance of Model for Prediction Across Scales (MPAS) Ocean as a +!! Global Barotropic Tide Model. Journal of Advances in Modeling Earth Systems, in review. +!! +!! Brus, S.R., Barton, K.N., Nairita, P., Roberts, A.F., Engwirda, D., Petersen, M.R., Arbic, B.K., Wirasaet, D., +!! Westerink, J., and Schindelegger, M., 2022: Scalable self attraction and loading calculations for unstructured ocean +!! models. Ocean Modelling, in review. end module MOM_tidal_forcing diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 1631a76dd6..9f5241bb9a 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -81,6 +81,9 @@ module MOM_ALE_sponge real :: scale = 1.0 !< A multiplicative factor by which to rescale input data real, dimension(:,:), pointer :: p => NULL() !< pointer the data. real, dimension(:,:), pointer :: h => NULL() !< pointer the data grid. + character(len=:), allocatable :: name !< The name of the input field + character(len=:), allocatable :: long_name !< The long name of the input field + character(len=:), allocatable :: unit !< The unit of the input field end type p2d !> ALE sponge control structure @@ -134,7 +137,7 @@ module MOM_ALE_sponge logical :: tripolar_N !< grid is folded at its north edge !>@{ Diagnostic IDs - integer, dimension(2) :: id_sp_tendency !< Diagnostic ids for temperature and salinity + integer, dimension(MAX_FIELDS_) :: id_sp_tendency !< Diagnostic ids for tracers !! tendency due to sponges integer :: id_sp_u_tendency !< Diagnostic id for zonal momentum tendency due to !! Rayleigh damping @@ -666,15 +669,19 @@ subroutine init_ALE_sponge_diags(Time, G, diag, CS, US) !! output. type(ALE_sponge_CS), intent(inout) :: CS !< ALE sponge control structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + ! Local Variables + integer :: m CS%diag => diag - CS%id_sp_tendency(1) = -1 - CS%id_sp_tendency(1) = register_diag_field('ocean_model', 'sp_tendency_temp', diag%axesTL, Time, & - 'Time tendency due to temperature restoring', 'degC s-1', conversion=US%s_to_T) - CS%id_sp_tendency(2) = -1 - CS%id_sp_tendency(2) = register_diag_field('ocean_model', 'sp_tendency_salt', diag%axesTL, Time, & - 'Time tendency due to salinity restoring', 'g kg-1 s-1', conversion=US%s_to_T) + do m=1,CS%fldno + CS%id_sp_tendency(m) = -1 + CS%id_sp_tendency(m) = register_diag_field('ocean_model', & + 'sp_tendency_' // CS%Ref_val(m)%name, diag%axesTL, Time, & + 'Time tendency due to restoring ' // CS%Ref_val(m)%long_name, & + CS%Ref_val(m)%unit, conversion=US%s_to_T) + enddo + CS%id_sp_u_tendency = -1 CS%id_sp_u_tendency = register_diag_field('ocean_model', 'sp_tendency_u', diag%axesCuL, Time, & 'Zonal acceleration due to sponges', 'm s-2', conversion=US%L_T2_to_m_s2) @@ -686,7 +693,8 @@ end subroutine init_ALE_sponge_diags !> This subroutine stores the reference profile at h points for the variable !! whose address is given by f_ptr. -subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, scale) +subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, & + sp_name, sp_long_name, sp_unit, scale) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(ALE_sponge_CS), pointer :: CS !< ALE sponge control structure (in/out). @@ -695,16 +703,27 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, scale) !! arbitrary number of layers. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: f_ptr !< Pointer to the field to be damped + character(len=*), intent(in) :: sp_name !< The name of the tracer field + character(len=*), optional, & + intent(in) :: sp_long_name !< The long name of the tracer field + !! if not given, use the sp_name + character(len=*), optional, & + intent(in) :: sp_unit !< The unit of the tracer field + !! if not given, use the none real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any !! contributions due to dimensional rescaling. The default is 1. real :: scale_fac ! A factor by which to scale sp_val before storing it. integer :: k, col character(len=256) :: mesg ! String for error messages + character(len=256) :: long_name ! The long name of the tracer field + character(len=256) :: unit ! The unit of the tracer field if (.not.associated(CS)) return scale_fac = 1.0 ; if (present(scale)) scale_fac = scale + long_name = sp_name; if (present(sp_long_name)) long_name = sp_long_name + unit = 'none'; if (present(sp_unit)) unit = sp_unit CS%fldno = CS%fldno + 1 if (CS%fldno > MAX_FIELDS_) then @@ -716,6 +735,9 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS, scale) ! stores the reference profile CS%Ref_val(CS%fldno)%nz_data = CS%nz_data + CS%Ref_val(CS%fldno)%name = sp_name + CS%Ref_val(CS%fldno)%long_name = long_name + CS%Ref_val(CS%fldno)%unit = unit allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,CS%nz_data @@ -729,7 +751,8 @@ end subroutine set_up_ALE_sponge_field_fixed !> This subroutine stores the reference profile at h points for the variable !! whose address is given by filename and fieldname. -subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, f_ptr, CS, scale) +subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, f_ptr, CS, & + sp_name, sp_long_name, sp_unit, scale) character(len=*), intent(in) :: filename !< The name of the file with the !! time varying field data character(len=*), intent(in) :: fieldname !< The name of the field in the file @@ -741,6 +764,13 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & target, intent(in) :: f_ptr !< Pointer to the field to be damped (in). type(ALE_sponge_CS), pointer :: CS !< Sponge control structure (in/out). + character(len=*), intent(in) :: sp_name !< The name of the tracer field + character(len=*), optional, & + intent(in) :: sp_long_name !< The long name of the tracer field + !! if not given, use the sp_name + character(len=*), optional, & + intent(in) :: sp_unit !< The unit of the tracer field + !! if not given, use 'none' real, optional, intent(in) :: scale !< A factor by which to rescale the input data, including any !! contributions due to dimensional rescaling. The default is 1. @@ -749,6 +779,11 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, integer, dimension(4) :: fld_sz integer :: nz_data !< the number of vertical levels in this input field character(len=256) :: mesg ! String for error messages + character(len=256) :: long_name ! The long name of the tracer field + character(len=256) :: unit ! The unit of the tracer field + long_name = sp_name; if (present(sp_long_name)) long_name = sp_long_name + unit = 'none'; if (present(sp_unit)) unit = sp_unit + ! Local variables for ALE remapping if (.not.associated(CS)) return @@ -768,6 +803,9 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, else CS%Ref_val(CS%fldno)%id = init_external_field(filename, fieldname) endif + CS%Ref_val(CS%fldno)%name = sp_name + CS%Ref_val(CS%fldno)%long_name = long_name + CS%Ref_val(CS%fldno)%unit = unit fld_sz(1:4) = -1 call get_external_field_info(CS%Ref_val(CS%fldno)%id, size=fld_sz) nz_data = fld_sz(3) @@ -1290,7 +1328,8 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) call rotate_array(sp_val_in, turns, sp_val) ! NOTE: This points sp_val with the unrotated field. See note below. - call set_up_ALE_sponge_field(sp_val, G, GV, sp_ptr, sponge) + call set_up_ALE_sponge_field(sp_val, G, GV, sp_ptr, sponge, & + sponge_in%Ref_val(n)%name, sp_long_name=sponge_in%Ref_val(n)%long_name, sp_unit=sponge_in%Ref_val(n)%unit) deallocate(sp_val_in) else diff --git a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 index 7c427ab79a..ba47f281e8 100644 --- a/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 +++ b/src/parameterizations/vertical/MOM_bkgnd_mixing.F90 @@ -9,7 +9,7 @@ module MOM_bkgnd_mixing use MOM_diag_mediator, only : diag_ctrl, time_type, register_diag_field use MOM_diag_mediator, only : post_data use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type @@ -63,9 +63,11 @@ module MOM_bkgnd_mixing real :: Kd_tanh_lat_scale !< A nondimensional scaling for the range of !! diffusivities with Kd_tanh_lat_fn. Valid values !! are in the range of -2 to 2; 0.4 reproduces CM2M. - real :: Kdml !< mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] - !! when bulkmixedlayer==.false. - real :: Hmix !< mixed layer thickness [Z ~> m] when bulkmixedlayer==.false. + real :: Kd_tot_ml !< The mixed layer diapycnal diffusivity [Z2 T-1 ~> m2 s-1] + !! when no other physically based mixed layer turbulence + !! parameterization is being used. + real :: Hmix !< mixed layer thickness [Z ~> m] when no physically based + !! ocean surface boundary layer parameterization is used. logical :: Kd_tanh_lat_fn !< If true, use the tanh dependence of Kd_sfc on !! latitude, like GFDL CM2.1/CM2M. There is no !! physical justification for this form, and it can @@ -78,21 +80,8 @@ module MOM_bkgnd_mixing !! Henyey et al, JGR (1986) latitudinal scaling for the background diapycnal diffusivity, !! which gives a marked decrease in the diffusivity near the equator. The simplification !! here is to assume that the in-situ stratification is the same as the reference stratificaiton. - logical :: Henyey_IGW_background_new !< same as Henyey_IGW_background - !! but incorporate the effect of stratification on TKE dissipation, - !! e = f/f_0 * acosh(N/f) / acosh(N_0/f_0) * e_0 - !! where e is the TKE dissipation, and N_0 and f_0 - !! are the reference buoyancy frequency and inertial frequencies respectively. - !! e_0 is the reference dissipation at (N_0,f_0). In the previous version, N=N_0. - !! Additionally, the squared inverse relationship between diapycnal diffusivities - !! and stratification is included: - !! - !! kd = e/N^2 - !! - !! where kd is the diapycnal diffusivity. This approach assumes that work done - !! against gravity is uniformly distributed throughout the column. Whereas, kd=kd_0*e, - !! as in the original version, concentrates buoyancy work in regions of strong stratification. - logical :: bulkmixedlayer !< If true, a refined bulk mixed layer scheme is used + logical :: physical_OBL_scheme !< If true, a physically-based scheme is used to determine mixing in the + !! ocean's surface boundary layer, such as ePBL, KPP, or a refined bulk mixed layer scheme. logical :: Kd_via_Kdml_bug !< If true and KDML /= KD and a number of other higher precedence !! options are not used, the background diffusivity is set incorrectly using a !! bug that was introduced in March, 2018. @@ -109,7 +98,7 @@ module MOM_bkgnd_mixing contains !> Initialize the background mixing routine. -subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) +subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS, physical_OBL_scheme) type(time_type), intent(in) :: Time !< The current time. type(ocean_grid_type), intent(in) :: G !< Grid structure. @@ -117,15 +106,20 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< Run-time parameter file handle type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure. - type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. + type(bkgnd_mixing_cs), pointer :: CS !< This module's control structure. + logical, intent(in) :: physical_OBL_scheme !< If true, a physically based + !! parameterization (like KPP or ePBL or a bulk mixed + !! layer) is used outside of set_diffusivity to + !! specify the mixing that occurs in the ocean's + !! surface boundary layer. ! Local variables real :: Kv ! The interior vertical viscosity [Z2 T-1 ~> m2 s-1] - read to set Prandtl ! number unless it is provided as a parameter real :: prandtl_bkgnd_comp ! Kv/CS%Kd. Gets compared with user-specified prandtl_bkgnd. -! This include declares and sets the variable "version". -#include "version_variable.h" + ! This include declares and sets the variable "version". +# include "version_variable.h" if (associated(CS)) then call MOM_error(WARNING, "bkgnd_mixing_init called with an associated "// & @@ -154,21 +148,38 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) ! The following is needed to set one of the choices of vertical background mixing - ! BULKMIXEDLAYER is not always defined (e.g., CM2G63L), so the following line by passes - ! the need to include BULKMIXEDLAYER in MOM_input - CS%bulkmixedlayer = (GV%nkml > 0) - if (CS%bulkmixedlayer) then + CS%physical_OBL_scheme = physical_OBL_scheme + if (CS%physical_OBL_scheme) then ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) - if (CS%Kdml>0.) call MOM_error(FATAL, & - "bkgnd_mixing_init: KDML cannot be set when using bulk mixed layer.") - CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also cannot be a NaN. + call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & + "bkgnd_mixing_init: KDML is a depricated parameter that should not be used.") + call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, default=-1., do_not_log=.true.) + if (CS%Kd_tot_ml>0.) call MOM_error(FATAL, & + "bkgnd_mixing_init: KD_ML_TOT cannot be set when using a physically based ocean "//& + "boundary layer mixing parameterization.") + CS%Kd_tot_ml = CS%Kd ! This is not used with a bulk mixed layer, but also cannot be a NaN. else - call get_param(param_file, mdl, "KDML", CS%Kdml, & + call get_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml, & + "The total diapcynal diffusivity in the surface mixed layer when there is "//& + "not a physically based parameterization of mixing in the mixed layer, such "//& + "as bulk mixed layer or KPP or ePBL.", & + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (abs(CS%Kd_tot_ml - CS%Kd) <= 1.0e-15*abs(CS%Kd)) then + call get_param(param_file, mdl, "KDML", CS%Kd_tot_ml, & "If BULKMIXEDLAYER is false, KDML is the elevated "//& "diapycnal diffusivity in the topmost HMIX of fluid. "//& "KDML is only used if BULKMIXEDLAYER is false.", & - units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T) + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (abs(CS%Kd_tot_ml - CS%Kd) > 1.0e-15*abs(CS%Kd)) & + call MOM_error(WARNING, "KDML is a depricated parameter. Use KD_ML_TOT instead.") + endif + call log_param(param_file, mdl, "KD_ML_TOT", CS%Kd_tot_ml*US%Z2_T_to_m2_s, & + "The total diapcynal diffusivity in the surface mixed layer when there is "//& + "not a physically based parameterization of mixing in the mixed layer, such "//& + "as bulk mixed layer or KPP or ePBL.", & + units="m2 s-1", default=CS%Kd*US%Z2_T_to_m2_s) + call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface "//& "viscosity and diffusivity are elevated when the bulk "//& @@ -251,13 +262,6 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "Harrison & Hallberg, JPO 2008.", default=.false.) if (CS%Henyey_IGW_background) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND") - - call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", CS%Henyey_IGW_background_new, & - "If true, use a better latitude-dependent scaling for the "//& - "background diffusivity, as described in "//& - "Harrison & Hallberg, JPO 2008.", default=.false.) - if (CS%Henyey_IGW_background_new) call check_bkgnd_scheme(CS, "HENYEY_IGW_BACKGROUND_NEW") - if (CS%Kd>0.0 .and. (trim(CS%bkgnd_scheme_str)=="BRYAN_LEWIS_DIFFUSIVITY" .or.& trim(CS%bkgnd_scheme_str)=="HORIZ_VARYING_BACKGROUND" )) then call MOM_error(WARNING, "bkgnd_mixing_init: a nonzero constant background "//& @@ -290,13 +294,13 @@ subroutine bkgnd_mixing_init(Time, G, GV, US, param_file, diag, CS) "MOM_bkgnd_mixing: KD_TANH_LAT_FN can not be used with HENYEY_IGW_BACKGROUND.") CS%Kd_via_Kdml_bug = .false. - if ((CS%Kd /= CS%Kdml) .and. .not.(CS%Kd_tanh_lat_fn .or. CS%bulkmixedlayer .or. & - CS%Henyey_IGW_background .or. CS%Henyey_IGW_background_new .or. & + if ((CS%Kd /= CS%Kd_tot_ml) .and. .not.(CS%Kd_tanh_lat_fn .or. CS%physical_OBL_scheme .or. & + CS%Henyey_IGW_background .or. & CS%horiz_varying_background .or. CS%Bryan_Lewis_diffusivity)) then call get_param(param_file, mdl, "KD_BACKGROUND_VIA_KDML_BUG", CS%Kd_via_Kdml_bug, & "If true and KDML /= KD and several other conditions apply, the background "//& "diffusivity is set incorrectly using a bug that was introduced in March, 2018.", & - default=.true.) ! The default should be changed to false and this parameter obsoleted. + default=.false.) ! This parameter should be obsoleted. endif ! call closeParameterBlock(param_file) @@ -428,25 +432,6 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, Kd_lay(i,k) = Kd_int(i,1) enddo ; enddo - elseif (CS%Henyey_IGW_background_new) then - I_x30 = 2.0 / invcosh(CS%N0_2Omega*2.0) ! This is evaluated at 30 deg. - I_2Omega = 0.5 / CS%omega - do k=1,nz ; do i=is,ie - abs_sinlat = max(min_sinlat, abs(sin(G%geoLatT(i,j)*deg_to_rad))) - N_2Omega = max(abs_sinlat, sqrt(N2_lay(i,k))*I_2Omega) - N02_N2 = (CS%N0_2Omega/N_2Omega)**2 - Kd_lay(i,k) = max(CS%Kd_min, CS%Kd * & - ((abs_sinlat * invcosh(N_2Omega/abs_sinlat)) * I_x30)*N02_N2) - enddo ; enddo - ! Update Kd_int and Kv_bkgnd, based on Kd_lay. These might be just used for diagnostic purposes. - do i=is,ie - Kd_int(i,1) = 0.0; Kv_bkgnd(i,1) = 0.0 - Kd_int(i,nz+1) = 0.0; Kv_bkgnd(i,nz+1) = 0.0 - enddo - do K=2,nz ; do i=is,ie - Kd_int(i,K) = 0.5*(Kd_lay(i,k-1) + Kd_lay(i,k)) - Kv_bkgnd(i,K) = Kd_int(i,K) * CS%prandtl_bkgnd - enddo ; enddo else ! Set a potentially spatially varying surface value of diffusivity. if (CS%Henyey_IGW_background) then @@ -471,7 +456,7 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, endif ! Now set background diffusivies based on these surface values, possibly with vertical structure. - if ((.not.CS%bulkmixedlayer) .and. (CS%Kd /= CS%Kdml)) then + if ((.not.CS%physical_OBL_scheme) .and. (CS%Kd /= CS%Kd_tot_ml)) then ! This is a crude way to put in a diffusive boundary layer without an explicit boundary ! layer turbulence scheme. It should not be used for any realistic ocean models. I_Hmix = 1.0 / (CS%Hmix + GV%H_subroundoff*GV%H_to_Z) @@ -481,16 +466,16 @@ subroutine calculate_bkgnd_mixing(h, tv, N2_lay, Kd_lay, Kd_int, Kv_bkgnd, j, G, if (CS%Kd_via_Kdml_bug) then ! These two lines should update Kd_lay, not Kd_int. They were correctly working on the ! same variables until MOM6 commit 7a818716 (PR#750), which was added on March 26, 2018. - if (depth_c <= CS%Hmix) then ; Kd_int(i,K) = CS%Kdml + if (depth_c <= CS%Hmix) then ; Kd_int(i,K) = CS%Kd_tot_ml elseif (depth_c >= 2.0*CS%Hmix) then ; Kd_int(i,K) = Kd_sfc(i) else - Kd_lay(i,k) = ((Kd_sfc(i) - CS%Kdml) * I_Hmix) * depth_c + (2.0*CS%Kdml - Kd_sfc(i)) + Kd_lay(i,k) = ((Kd_sfc(i) - CS%Kd_tot_ml) * I_Hmix) * depth_c + (2.0*CS%Kd_tot_ml - Kd_sfc(i)) endif else - if (depth_c <= CS%Hmix) then ; Kd_lay(i,k) = CS%Kdml + if (depth_c <= CS%Hmix) then ; Kd_lay(i,k) = CS%Kd_tot_ml elseif (depth_c >= 2.0*CS%Hmix) then ; Kd_lay(i,k) = Kd_sfc(i) else - Kd_lay(i,k) = ((Kd_sfc(i) - CS%Kdml) * I_Hmix) * depth_c + (2.0*CS%Kdml - Kd_sfc(i)) + Kd_lay(i,k) = ((Kd_sfc(i) - CS%Kd_tot_ml) * I_Hmix) * depth_c + (2.0*CS%Kd_tot_ml - Kd_sfc(i)) endif endif diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index aa0d05ce79..49d62bbde4 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -49,6 +49,7 @@ module MOM_bulk_mixed_layer !! the mixed layer is converted to TKE [nondim]. real :: bulk_Ri_convective !< The efficiency with which convectively !! released mean kinetic energy becomes TKE [nondim]. + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] real :: Hmix_min !< The minimum mixed layer thickness [H ~> m or kg m-2]. real :: H_limit_fluxes !< When the total ocean depth is less than this !! value [H ~> m or kg m-2], scale away all surface forcing to @@ -316,7 +317,7 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C real :: H_nbr ! A minimum thickness based on neighboring thicknesses [H ~> m or kg m-2]. real :: absf_x_H ! The absolute value of f times the mixed layer thickness [Z T-1 ~> m s-1]. - real :: kU_star ! Ustar times the Von Karmen constant [Z T-1 ~> m s-1]. + real :: kU_star ! Ustar times the Von Karman constant [Z T-1 ~> m s-1]. real :: dt__diag ! A recaled copy of dt_diag (if present) or dt [T ~> s]. logical :: write_diags ! If true, write out diagnostics with this step. logical :: reset_diags ! If true, zero out the accumulated diagnostics. @@ -618,12 +619,12 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C ! as the third piece will then optimally describe mixed layer ! restratification. For nkml>=4 the whole strategy should be revisited. do i=is,ie - kU_star = 0.41*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? + kU_star = CS%vonKar*fluxes%ustar(i,j) ! Maybe could be replaced with u*+w*? if (associated(fluxes%ustar_shelf) .and. & associated(fluxes%frac_shelf_h)) then if (fluxes%frac_shelf_h(i,j) > 0.0) & kU_star = (1.0 - fluxes%frac_shelf_h(i,j)) * kU_star + & - fluxes%frac_shelf_h(i,j) * (0.41*fluxes%ustar_shelf(i,j)) + fluxes%frac_shelf_h(i,j) * (CS%vonKar*fluxes%ustar_shelf(i,j)) endif absf_x_H = 0.25 * GV%H_to_Z * h(i,0) * & ((abs(G%CoriolisBu(I,J)) + abs(G%CoriolisBu(I-1,J-1))) + & @@ -1344,11 +1345,11 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, ! the equatorial areas. Although it is not cast as a parameter, it should ! be considered an empirical parameter, and it might depend strongly on the ! number of sublayers in the mixed layer and their locations. -! The 0.41 is VonKarman's constant. This equation assumes that small & large -! scales contribute to mixed layer deepening at similar rates, even though -! small scales are dissipated more rapidly (implying they are less efficient). -! Ih = 1.0/(16.0*0.41*U_star*dt) - Ih = GV%H_to_Z/(3.0*0.41*U_star*dt) +! This equation assumes that small & large scales contribute to mixed layer +! deepening at similar rates, even though small scales are dissipated more +! rapidly (implying they are less efficient). +! Ih = 1.0/(16.0*CS%vonKar*U_star*dt) + Ih = GV%H_to_Z/(3.0*CS%vonKar*U_star*dt) cMKE(1,i) = 4.0 * Ih ; cMKE(2,i) = (absf_Ustar*GV%H_to_Z) * Ih if (Idecay_len_TKE(i) > 0.0) then @@ -3387,6 +3388,9 @@ subroutine bulkmixedlayer_init(Time, G, GV, US, param_file, diag, CS) "kinetic energy is converted to turbulent kinetic "//& "energy. By default BULK_RI_CONVECTIVE=BULK_RI_ML.", & units="nondim", default=CS%bulk_Ri_ML) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth "//& "is determined dynamically.", units="m", default=0.0, scale=GV%m_to_H, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index b4cb46830d..a3450bd6e4 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -153,8 +153,7 @@ subroutine make_frazil(h, tv, G, GV, US, CS, p_surf, halo) pressure(i,1) = ps(i) + (0.5*H_to_RL2_T2)*h(i,j,1) enddo do k=2,nz ; do i=is,ie - pressure(i,k) = pressure(i,k-1) + & - (0.5*H_to_RL2_T2) * (h(i,j,k) + h(i,j,k-1)) + pressure(i,k) = pressure(i,k-1) + (0.5*H_to_RL2_T2) * (h(i,j,k) + h(i,j,k-1)) enddo ; enddo endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index a85dbdd787..ddafbc3274 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2955,6 +2955,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di character(len=48) :: thickness_units character(len=40) :: var_name character(len=160) :: var_descript + logical :: physical_OBL_scheme integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nbands, m isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -3464,9 +3465,11 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di call internal_tides_init(Time, G, GV, US, param_file, diag, CS%int_tide) endif + physical_OBL_scheme = (CS%use_bulkmixedlayer .or. CS%use_KPP .or. CS%use_energetic_PBL) ! initialize module for setting diffusivities call set_diffusivity_init(Time, G, GV, US, param_file, diag, CS%set_diff_CSp, CS%int_tide, & - halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse) + halo_TS=CS%halo_TS_diff, double_diffuse=CS%double_diffuse, & + physical_OBL_scheme=physical_OBL_scheme) if (CS%useKPP .and. (CS%double_diffuse .and. .not.CS%use_CVMix_ddiff)) & call MOM_error(FATAL, 'diabatic_driver_init: DOUBLE_DIFFUSION (old method) does not work '//& diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index 975a11d909..2ddf8b8c7a 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -27,8 +27,9 @@ module MOM_diapyc_energy_req type, public :: diapyc_energy_req_CS ; private logical :: initialized = .false. !< A variable that is here because empty !! structures are not permitted by some compilers. - real :: test_Kh_scaling !< A scaling factor for the diapycnal diffusivity. - real :: ColHt_scaling !< A scaling factor for the column height change correction term. + real :: test_Kh_scaling !< A scaling factor for the diapycnal diffusivity [nondim] + real :: ColHt_scaling !< A scaling factor for the column height change correction term [nondim] + real :: VonKar !< The von Karman coefficient as used in this module [nondim] logical :: use_test_Kh_profile !< If true, use the internal test diffusivity profile in place of !! any that might be passed in as an argument. type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to @@ -104,7 +105,7 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, US, CS, Kd_int) do K=2,nz tmp1 = h_top(K) * h_bot(K) * GV%H_to_Z Kd(K) = CS%test_Kh_scaling * & - ustar * 0.41 * (tmp1*ustar) / (absf*tmp1 + htot*ustar) + ustar * CS%VonKar * (tmp1*ustar) / (absf*tmp1 + htot*ustar) enddo endif may_print = is_root_PE() .and. (i==ie) .and. (j==je) @@ -1292,10 +1293,12 @@ subroutine diapyc_energy_req_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "ENERGY_REQ_COL_HT_SCALING", CS%ColHt_scaling, & "A scaling factor for the column height change correction "//& "used in testing the energy requirements.", default=1.0, units="nondim") - call get_param(param_file, mdl, "ENERGY_REQ_USE_TEST_PROFILE", & - CS%use_test_Kh_profile, & + call get_param(param_file, mdl, "ENERGY_REQ_USE_TEST_PROFILE", CS%use_test_Kh_profile, & "If true, use the internal test diffusivity profile in "//& "place of any that might be passed in as an argument.", default=.false.) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) CS%id_ERt = register_diag_field('ocean_model', 'EnReqTest_ERt', diag%axesZi, Time, & "Diffusivity Energy Requirements, top-down", & diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 0e090b12e3..862f775225 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -36,8 +36,7 @@ module MOM_energetic_PBL logical :: initialized = .false. !< True if this control structure has been initialized. !/ Constants - real :: VonKar = 0.41 !< The von Karman coefficient. This should be a runtime parameter, - !! but because it is set to 0.4 at runtime in KPP it might change answers. + real :: VonKar !< The von Karman coefficient as used in the ePBL module [nondim] real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: omega_frac !< When setting the decay scale for turbulence, use this fraction of !! the absolute rotation rate blended with the local value of f, as @@ -1982,6 +1981,9 @@ subroutine energetic_PBL_init(Time, G, GV, US, param_file, diag, CS) "A nondimensional scaling factor controlling the inhibition "//& "of the diffusive length scale by rotation. Making this larger "//& "decreases the PBL diffusivity.", units="nondim", default=1.0) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & "This sets the default value for the various _ANSWER_DATE parameters.", & default=99991231) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index f7673b347d..118ec9a1a1 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -1858,7 +1858,7 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "KAPPA_SHEAR_VERTEX_PSURF_BUG", CS%psurf_bug, & "If true, do a simple average of the cell surface pressures to get a pressure "//& "at the corner if VERTEX_SHEAR=True. Otherwise mask out any land points in "//& - "the average.", default=.true., do_not_log=(just_read .or. (.not.CS%KS_at_vertex))) + "the average.", default=.false., do_not_log=(just_read .or. (.not.CS%KS_at_vertex))) call get_param(param_file, mdl, "KAPPA_SHEAR_ITER_BUG", CS%dKdQ_iteration_bug, & "If true, use an older, dimensionally inconsistent estimate of the "//& diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 2e27877350..6d35616b3a 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -73,6 +73,8 @@ module MOM_set_diffusivity !! added. logical :: use_LOTW_BBL_diffusivity !< If true, use simpler/less precise, BBL diffusivity. logical :: LOTW_BBL_use_omega !< If true, use simpler/less precise, BBL diffusivity. + real :: Von_Karm !< The von Karman constant as used in the BBL diffusivity calculation + !! [nondim]. See (http://en.wikipedia.org/wiki/Von_Karman_constant) real :: BBL_effic !< efficiency with which the energy extracted !! by bottom drag drives BBL diffusion [nondim] real :: cdrag !< quadratic drag coefficient [nondim] @@ -1406,7 +1408,6 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int logical :: Rayleigh_drag ! Set to true if there are Rayleigh drag velocities defined in visc, on ! the assumption that this extracted energy also drives diapycnal mixing. integer :: i, k, km1 - real, parameter :: von_karm = 0.41 ! Von Karman constant (http://en.wikipedia.org/wiki/Von_Karman_constant) logical :: do_diag_Kd_BBL if (.not.(CS%bottomdraglaw .and. (CS%BBL_effic > 0.0))) return @@ -1483,7 +1484,7 @@ subroutine add_LOTW_BBL_diffusivity(h, u, v, tv, fluxes, visc, j, N2_int, Kd_int if ( ustar_D + absf * ( z_bot * D_minus_z ) == 0.) then Kd_wall = 0. else - Kd_wall = ((von_karm * ustar2) * (z_bot * D_minus_z)) & + Kd_wall = ((CS%von_karm * ustar2) * (z_bot * D_minus_z)) & / (ustar_D + absf * (z_bot * D_minus_z)) endif @@ -1963,7 +1964,7 @@ subroutine set_density_ratios(h, tv, kb, G, GV, US, CS, j, ds_dsp1, rho_0) end subroutine set_density_ratios subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_CSp, halo_TS, & - double_diffuse) + double_diffuse, physical_OBL_scheme) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -1974,10 +1975,15 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ type(set_diffusivity_CS), pointer :: CS !< pointer set to point to the module control !! structure. type(int_tide_CS), intent(in), target :: int_tide_CSp !< Internal tide control struct - integer, optional, intent(out) :: halo_TS !< The halo size of tracer points that must be + integer, intent(out) :: halo_TS !< The halo size of tracer points that must be !! valid for the calculations in set_diffusivity. logical, intent(out) :: double_diffuse !< This indicates whether some version !! of double diffusion is being used. + logical, intent(in) :: physical_OBL_scheme !< If true, a physically based + !! parameterization (like KPP or ePBL or a bulk mixed + !! layer) is used outside of set_diffusivity to + !! specify the mixing that occurs in the ocean's + !! surface boundary layer. ! Local variables real :: decay_length @@ -1990,6 +1996,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. + real :: vonKar ! The von Karman constant as used for mixed layer viscosity [nomdim] real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate ! that is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] @@ -2147,6 +2154,12 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ call get_param(param_file, mdl, "LOTW_BBL_USE_OMEGA", CS%LOTW_BBL_use_omega, & "If true, use the maximum of Omega and N for the TKE to diffusion "//& "calculation. Otherwise, N is N.", default=.true.) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) + call get_param(param_file, mdl, 'VON_KARMAN_BBL', CS%von_Karm, & + 'The value the von Karman constant as used in calculating the BBL diffusivity.', & + units='nondim', default=vonKar) endif else CS%use_LOTW_BBL_diffusivity = .false. ! This parameterization depends on a u* from viscous BBL @@ -2164,7 +2177,7 @@ subroutine set_diffusivity_init(Time, G, GV, US, param_file, diag, CS, int_tide_ default=.false., do_not_log=.not.TKE_to_Kd_used) ! set params related to the background mixing - call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp) + call bkgnd_mixing_init(Time, G, GV, US, param_file, CS%diag, CS%bkgnd_mixing_csp, physical_OBL_scheme) call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. "//& diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 9bd995633f..80be1ed12f 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -23,7 +23,7 @@ module MOM_set_visc use MOM_restart, only : register_restart_field_as_obsolete use MOM_safe_alloc, only : safe_alloc_ptr, safe_alloc_alloc use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_ptrs +use MOM_variables, only : thermo_var_ptrs, vertvisc_type, porous_barrier_type use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, calculate_density_derivs use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_DIRECTION_E @@ -74,25 +74,27 @@ module MOM_set_visc !! the properties of the bottom boundary layer. logical :: linear_drag !< If true, the drag law is cdrag*`DRAG_BG_VEL`*u. !! Runtime parameter `LINEAR_DRAG`. - logical :: Channel_drag !< If true, the drag is exerted directly on each - !! layer according to what fraction of the bottom - !! they overlie. + logical :: Channel_drag !< If true, the drag is exerted directly on each layer + !! according to what fraction of the bottom they overlie. + real :: Chan_drag_max_vol !< The maximum bottom boundary layer volume within which the + !! channel drag is applied, normalized by the the full cell area, + !! or a negative value to apply no maximum [H ~> m or kg m-2]. logical :: correct_BBL_bounds !< If true, uses the correct bounds on the BBL thickness and !! viscosity so that the bottom layer feels the intended drag. logical :: RiNo_mix !< If true, use Richardson number dependent mixing. logical :: dynamic_viscous_ML !< If true, use a bulk Richardson number criterion to !! determine the mixed layer thickness for viscosity. real :: bulk_Ri_ML !< The bulk mixed layer used to determine the - !! thickness of the viscous mixed layer. Nondim. + !! thickness of the viscous mixed layer [nondim] real :: omega !< The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min !< A minimum value of ustar to avoid numerical !! problems [Z T-1 ~> m s-1]. If the value is small enough, !! this should not affect the solution. real :: TKE_decay !< The ratio of the natural Ekman depth to the TKE - !! decay scale, nondimensional. - real :: omega_frac !< When setting the decay scale for turbulence, use - !! this fraction of the absolute rotation rate blended - !! with the local value of f, as sqrt((1-of)*f^2 + of*4*omega^2). + !! decay scale [nondim] + real :: omega_frac !< When setting the decay scale for turbulence, use this + !! fraction of the absolute rotation rate blended with the local + !! value of f, as sqrt((1-of)*f^2 + of*4*omega^2) [nondim] integer :: answer_date !< The vintage of the order of arithmetic and expressions in the set !! viscosity calculations. Values below 20190101 recover the answers !! from the end of 2018, while higher values use updated and more robust @@ -137,7 +139,7 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) !! related fields. type(set_visc_CS), intent(inout) :: CS !< The control structure returned by a previous !! call to set_visc_init. - type(porous_barrier_ptrs),intent(in) :: pbv !< porous barrier fractional cell metrics + type(porous_barrier_type),intent(in) :: pbv !< porous barrier fractional cell metrics ! Local variables real, dimension(SZIB_(G)) :: & @@ -233,6 +235,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) real :: a2x48_apb3, Iapb, Ibma_2 ! Combinations of a and slope [H-1 ~> m-1 or m2 kg-1]. ! All of the following "volumes" have units of thickness because they are normalized ! by the full horizontal area of a velocity cell. + real :: Vol_bbl_chan ! The volume of the bottom boundary layer as used in the channel + ! drag parameterization, normalized by the full horizontal area + ! of the velocity cell [H ~> m or kg m-2]. real :: Vol_open ! The cell volume above which it is open [H ~> m or kg m-2]. real :: Vol_direct ! With less than Vol_direct [H ~> m or kg m-2], there is a direct ! solution of a cubic equation for L. @@ -733,6 +738,9 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (bbl_thick < CS%BBL_thick_min) bbl_thick = CS%BBL_thick_min endif + ! Store the normalized bottom boundary layer volume. + if (CS%Channel_drag) Vol_bbl_chan = bbl_thick + ! If there is Richardson number dependent mixing, that determines ! the vertical extent of the bottom boundary layer, and there is no ! need to set that scale here. In fact, viscously reducing the @@ -746,10 +754,13 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) if (CS%body_force_drag) bbl_thick = h_bbl_drag(i) if (CS%Channel_drag) then - ! The drag within the bottommost bbl_thick is applied as a part of + ! The drag within the bottommost Vol_bbl_chan is applied as a part of ! an enhanced bottom viscosity, while above this the drag is applied ! directly to the layers in question as a Rayleigh drag term. + ! Restrict the volume over which the channel drag is applied. + if (CS%Chan_drag_max_vol >= 0.0) Vol_bbl_chan = min(Vol_bbl_chan, CS%Chan_drag_max_vol) + !### The harmonic mean edge depths here are not invariant to offsets! if (m==1) then D_vel = D_u(I,j) @@ -931,8 +942,8 @@ subroutine set_viscous_BBL(u, v, h, tv, visc, G, GV, US, CS, pbv) ! Determine the drag contributing to the bottom boundary layer ! and the Rayleigh drag that acts on each layer. if (L(K) > L(K+1)) then - if (vol_below < bbl_thick) then - BBL_frac = (1.0-vol_below/bbl_thick)**2 + if (vol_below < Vol_bbl_chan) then + BBL_frac = (1.0-vol_below/Vol_bbl_chan)**2 BBL_visc_frac = BBL_visc_frac + BBL_frac*(L(K) - L(K+1)) else BBL_frac = 0.0 @@ -1957,6 +1968,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS real :: omega_frac_dflt ! The default value for the fraction of the absolute rotation rate that ! is used in place of the absolute value of the local Coriolis ! parameter in the denominator of some expressions [nondim] + real :: Chan_max_thick_dflt ! The default value for CHANNEL_DRAG_MAX_THICK [m] + real :: Z_rescale ! A rescaling factor for heights from the representation in ! a restart file to the internal representation in this run. real :: I_T_rescale ! A rescaling factor for time from the internal representation in this run @@ -2037,10 +2050,9 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS do_not_log=.true.) if (adiabatic) then call log_param(param_file, mdl, "ADIABATIC",adiabatic, & - "There are no diapycnal mass fluxes if ADIABATIC is "//& - "true. This assumes that KD = KDML = 0.0 and that "//& - "there is no buoyancy forcing, but makes the model "//& - "faster by eliminating subroutine calls.", default=.false.) + "There are no diapycnal mass fluxes if ADIABATIC is true. "//& + "This assumes that KD = 0.0 and that there is no buoyancy forcing, "//& + "but makes the model faster by eliminating subroutine calls.", default=.false.) endif if (.not.adiabatic) then @@ -2098,11 +2110,11 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & - "The thickness of a bottom boundary layer with a "//& - "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& - "the thickness over which near-bottom velocities are "//& - "averaged for the drag law if BOTTOMDRAGLAW is defined "//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) ! Rescaled later + "The thickness of a bottom boundary layer with a viscosity increased by "//& + "KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//& + "near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//& + "defined but LINEAR_DRAG is not.", & + units="m", fail_if_missing=.true.) ! Rescaled later if (CS%bottomdraglaw) then call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of "//& @@ -2154,9 +2166,6 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS "The thickness over which near-surface velocities are "//& "averaged for the drag law under an ice shelf. By "//& "default this is the same as HBBL", units="m", default=CS%Hbbl, scale=GV%m_to_H) - ! These unit conversions are out outside the get_param calls because the are also defaults. - CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale - CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. "//& @@ -2195,9 +2204,24 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%c_Smag < 0.0) CS%c_Smag = 0.15 endif + Chan_max_thick_dflt = -1.0 + if (CS%RiNo_mix) Chan_max_thick_dflt = 0.5*CS%Hbbl + if (CS%body_force_drag) Chan_max_thick_dflt = CS%Hbbl + call get_param(param_file, mdl, "CHANNEL_DRAG_MAX_BBL_THICK", CS%Chan_drag_max_vol, & + "The maximum bottom boundary layer thickness over which the channel drag is "//& + "exerted, or a negative value for no fixed limit, instead basing the BBL "//& + "thickness on the bottom stress, rotation and stratification. The default is "//& + "proportional to HBBL if USE_JACKSON_PARAM or DRAG_AS_BODY_FORCE is true.", & + units="m", default=Chan_max_thick_dflt, scale=GV%m_to_H, & + do_not_log=.not.CS%Channel_drag) + call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) + ! These unit conversions are out outside the get_param calls because they are also defaults. + CS%Hbbl = CS%Hbbl * GV%m_to_H ! Rescale + CS%BBL_thick_min = CS%BBL_thick_min * GV%m_to_H ! Rescale + if (CS%RiNo_mix .and. kappa_shear_at_vertex(param_file)) then ! This is necessary for reproduciblity across restarts in non-symmetric mode. call pass_var(visc%Kv_shear_Bu, G%Domain, position=CORNER, complete=.true.) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 21ae10fef2..dff879d83e 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -6,10 +6,10 @@ module MOM_vert_friction use MOM_diag_mediator, only : post_data, register_diag_field, safe_alloc_ptr use MOM_diag_mediator, only : post_product_u, post_product_sum_u use MOM_diag_mediator, only : post_product_v, post_product_sum_v -use MOM_diag_mediator, only : diag_ctrl +use MOM_diag_mediator, only : diag_ctrl, query_averaging_enabled use MOM_debugging, only : uvchksum, hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, NOTE -use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_file_parser, only : get_param, log_param, log_version, param_file_type use MOM_forcing_type, only : mech_forcing use MOM_get_input, only : directories use MOM_grid, only : ocean_grid_type @@ -43,11 +43,15 @@ module MOM_vert_friction real :: Hmix !< The mixed layer thickness in thickness units [H ~> m or kg m-2]. real :: Hmix_stress !< The mixed layer thickness over which the wind !! stress is applied with direct_stress [H ~> m or kg m-2]. - real :: Kvml !< The mixed layer vertical viscosity [Z2 T-1 ~> m2 s-1]. + real :: Kvml_invZ2 !< The extra vertical viscosity scale in [Z2 T-1 ~> m2 s-1] in a + !! surface mixed layer with a characteristic thickness given by Hmix, + !! and scaling proportional to (Hmix/z)^2, where z is the distance + !! from the surface; this can get very large with thin layers. real :: Kv !< The interior vertical viscosity [Z2 T-1 ~> m2 s-1]. real :: Hbbl !< The static bottom boundary layer thickness [H ~> m or kg m-2]. - real :: Kvbbl !< The vertical viscosity in the bottom boundary - !! layer [Z2 T-1 ~> m2 s-1]. + real :: Kv_extra_bbl !< An extra vertical viscosity in the bottom boundary layer of thickness + !! Hbbl when there is not a bottom drag law in use [Z2 T-1 ~> m2 s-1]. + real :: vonKar !< The von Karman constant as used for mixed layer viscosity [nomdim] real :: maxvel !< Velocity components greater than maxvel are truncated [L T-1 ~> m s-1]. real :: vel_underflow !< Velocity components smaller than vel_underflow @@ -93,13 +97,23 @@ module MOM_vert_friction real :: harm_BL_val !< A scale to determine when water is in the boundary !! layers based solely on harmonic mean thicknesses !! for the purpose of determining the extent to which - !! the thicknesses used in the viscosities are upwinded. - logical :: direct_stress !< If true, the wind stress is distributed over the - !! topmost Hmix_stress of fluid and KVML may be very small. + !! the thicknesses used in the viscosities are upwinded [nondim]. + logical :: direct_stress !< If true, the wind stress is distributed over the topmost Hmix_stress + !! of fluid, and an added mixed layer viscosity or a physically based + !! boundary layer turbulence parameterization is not needed for stability. logical :: dynamic_viscous_ML !< If true, use the results from a dynamic !! calculation, perhaps based on a bulk Richardson !! number criterion, to determine the mixed layer !! thickness for viscosity. + logical :: fixed_LOTW_ML !< If true, use a Law-of-the-wall prescription for the mixed layer + !! viscosity within a boundary layer that is the lesser of Hmix and the + !! total depth of the ocean in a column. + logical :: apply_LOTW_floor !< If true, use a Law-of-the-wall prescription to set a lower bound + !! on the viscous coupling between layers within the surface boundary + !! layer, based the distance of interfaces from the surface. This only + !! acts when there are large changes in the thicknesses of successive + !! layers or when the viscosity is set externally and the wind stress + !! has subsequently increased. integer :: answer_date !< The vintage of the order of arithmetic and expressions in the viscous !! calculations. Values below 20190101 recover the answers from the end !! of 2018, while higher values use expressions that do not use an @@ -150,7 +164,7 @@ module MOM_vert_friction !! is the interfacial coupling thickness per time step, !! encompassing background viscosity as well as contributions from !! enhanced mixed and bottom layer viscosities. -!! $r_k$ is a Rayleight drag term due to channel drag. +!! $r_k$ is a Rayleigh drag term due to channel drag. !! There is an additional stress term on the right-hand side !! if DIRECT_STRESS is true, applied to the surface layer. @@ -298,7 +312,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! denote the diagonal of the system as b_k, the subdiagonal as a_k ! and the superdiagonal as c_k. The right-hand side terms are d_k. ! - ! ignoring the rayleigh drag contribution, + ! ignoring the Rayleigh drag contribution, ! we have a_k = -dt_Z_to_H * a_u(k) ! b_k = h_u(k) + dt_Z_to_H * (a_u(k) + a_u(k+1)) ! c_k = -dt_Z_to_H * a_u(k+1) @@ -500,49 +514,51 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif ! Offer diagnostic fields for averaging. - if (CS%id_du_dt_visc > 0) & - call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) - if (CS%id_dv_dt_visc > 0) & - call post_data(CS%id_dv_dt_visc, ADp%dv_dt_visc, CS%diag) - if (present(taux_bot) .and. (CS%id_taux_bot > 0)) & - call post_data(CS%id_taux_bot, taux_bot, CS%diag) - if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & - call post_data(CS%id_tauy_bot, tauy_bot, CS%diag) - if (CS%id_du_dt_str > 0) & - call post_data(CS%id_du_dt_str, ADp%du_dt_str, CS%diag) - if (CS%id_dv_dt_str > 0) & - call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) - - if (associated(ADp%du_dt_visc) .and. associated(ADp%du_dt_visc)) then - ! Diagnostics of the fractional thicknesses times momentum budget terms - ! 3D diagnostics of hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. - ! The code is retained for debugging purposes in the future. - !if (CS%id_hf_du_dt_visc > 0) & - ! call post_product_u(CS%id_hf_du_dt_visc, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) - !if (CS%id_hf_dv_dt_visc > 0) & - ! call post_product_v(CS%id_hf_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) - - ! Diagnostics for thickness-weighted vertically averaged viscous accelerations - if (CS%id_hf_du_dt_visc_2d > 0) & - call post_product_sum_u(CS%id_hf_du_dt_visc_2d, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) - if (CS%id_hf_dv_dt_visc_2d > 0) & - call post_product_sum_v(CS%id_hf_dv_dt_visc_2d, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) - - ! Diagnostics for thickness x viscous accelerations - if (CS%id_h_du_dt_visc > 0) call post_product_u(CS%id_h_du_dt_visc, ADp%du_dt_visc, ADp%diag_hu, G, nz, CS%diag) - if (CS%id_h_dv_dt_visc > 0) call post_product_v(CS%id_h_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hv, G, nz, CS%diag) - endif + if (query_averaging_enabled(CS%diag)) then + if (CS%id_du_dt_visc > 0) & + call post_data(CS%id_du_dt_visc, ADp%du_dt_visc, CS%diag) + if (CS%id_dv_dt_visc > 0) & + call post_data(CS%id_dv_dt_visc, ADp%dv_dt_visc, CS%diag) + if (present(taux_bot) .and. (CS%id_taux_bot > 0)) & + call post_data(CS%id_taux_bot, taux_bot, CS%diag) + if (present(tauy_bot) .and. (CS%id_tauy_bot > 0)) & + call post_data(CS%id_tauy_bot, tauy_bot, CS%diag) + if (CS%id_du_dt_str > 0) & + call post_data(CS%id_du_dt_str, ADp%du_dt_str, CS%diag) + if (CS%id_dv_dt_str > 0) & + call post_data(CS%id_dv_dt_str, ADp%dv_dt_str, CS%diag) + + if (associated(ADp%du_dt_visc) .and. associated(ADp%du_dt_visc)) then + ! Diagnostics of the fractional thicknesses times momentum budget terms + ! 3D diagnostics of hf_du(dv)_dt_visc are commented because there is no clarity on proper remapping grid option. + ! The code is retained for debugging purposes in the future. + !if (CS%id_hf_du_dt_visc > 0) & + ! call post_product_u(CS%id_hf_du_dt_visc, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + !if (CS%id_hf_dv_dt_visc > 0) & + ! call post_product_v(CS%id_hf_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness-weighted vertically averaged viscous accelerations + if (CS%id_hf_du_dt_visc_2d > 0) & + call post_product_sum_u(CS%id_hf_du_dt_visc_2d, ADp%du_dt_visc, ADp%diag_hfrac_u, G, nz, CS%diag) + if (CS%id_hf_dv_dt_visc_2d > 0) & + call post_product_sum_v(CS%id_hf_dv_dt_visc_2d, ADp%dv_dt_visc, ADp%diag_hfrac_v, G, nz, CS%diag) + + ! Diagnostics for thickness x viscous accelerations + if (CS%id_h_du_dt_visc > 0) call post_product_u(CS%id_h_du_dt_visc, ADp%du_dt_visc, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_visc > 0) call post_product_v(CS%id_h_dv_dt_visc, ADp%dv_dt_visc, ADp%diag_hv, G, nz, CS%diag) + endif - if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then - ! Diagnostics for thickness x wind stress accelerations - if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) - if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) + if (associated(ADp%du_dt_str) .and. associated(ADp%dv_dt_str)) then + ! Diagnostics for thickness x wind stress accelerations + if (CS%id_h_du_dt_str > 0) call post_product_u(CS%id_h_du_dt_str, ADp%du_dt_str, ADp%diag_hu, G, nz, CS%diag) + if (CS%id_h_dv_dt_str > 0) call post_product_v(CS%id_h_dv_dt_str, ADp%dv_dt_str, ADp%diag_hv, G, nz, CS%diag) - ! Diagnostics for wind stress accelerations multiplied by visc_rem_[uv], - if (CS%id_du_dt_str_visc_rem > 0) & - call post_product_u(CS%id_du_dt_str_visc_rem, ADp%du_dt_str, ADp%visc_rem_u, G, nz, CS%diag) - if (CS%id_dv_dt_str_visc_rem > 0) & - call post_product_v(CS%id_dv_dt_str_visc_rem, ADp%dv_dt_str, ADp%visc_rem_v, G, nz, CS%diag) + ! Diagnostics for wind stress accelerations multiplied by visc_rem_[uv], + if (CS%id_du_dt_str_visc_rem > 0) & + call post_product_u(CS%id_du_dt_str_visc_rem, ADp%du_dt_str, ADp%visc_rem_u, G, nz, CS%diag) + if (CS%id_dv_dt_str_visc_rem > 0) & + call post_product_v(CS%id_dv_dt_str_visc_rem, ADp%dv_dt_str, ADp%visc_rem_v, G, nz, CS%diag) + endif endif end subroutine vertvisc @@ -713,11 +729,11 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real, allocatable, dimension(:,:,:) :: Kv_v !< Total vertical viscosity at v-points [Z2 T-1 ~> m2 s-1]. real :: zcol(SZI_(G)) ! The height of an interface at h-points [H ~> m or kg m-2]. real :: botfn ! A function which goes from 1 at the bottom to 0 much more - ! than Hbbl into the interior. + ! than Hbbl into the interior [nondim]. real :: topfn ! A function which goes from 1 at the top to 0 much more - ! than Htbl into the interior. + ! than Htbl into the interior [nondim]. real :: z2 ! The distance from the bottom, normalized by Hbbl [nondim] - real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2. + real :: z2_wt ! A nondimensional (0-1) weight used when calculating z2 [nondim]. real :: z_clear ! The clearance of an interface above the surrounding topography [H ~> m or kg m-2]. real :: a_cpl_max ! The maximum drag coefficient across interfaces, set so that it will be ! representable as a 32-bit float in MKS units [Z T-1 ~> m s-1] @@ -726,7 +742,7 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) real :: I_valBL ! The inverse of a scaling factor determining when water is ! still within the boundary layer, as determined by the sum - ! of the harmonic mean thicknesses. + ! of the harmonic mean thicknesses [nondim]. logical, dimension(SZIB_(G)) :: do_i, do_i_shelf logical :: do_any_shelf integer, dimension(SZIB_(G)) :: & @@ -1103,16 +1119,18 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) endif ! Offer diagnostic fields for averaging. - if (associated(visc%Kv_slow) .and. (CS%id_Kv_slow > 0)) & - call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) - if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) - if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) - if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) - if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) - if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) - if (CS%id_h_v > 0) call post_data(CS%id_h_v, CS%h_v, CS%diag) - if (CS%id_hML_u > 0) call post_data(CS%id_hML_u, hML_u, CS%diag) - if (CS%id_hML_v > 0) call post_data(CS%id_hML_v, hML_v, CS%diag) + if (query_averaging_enabled(CS%diag)) then + if (associated(visc%Kv_slow) .and. (CS%id_Kv_slow > 0)) & + call post_data(CS%id_Kv_slow, visc%Kv_slow, CS%diag) + if (CS%id_Kv_u > 0) call post_data(CS%id_Kv_u, Kv_u, CS%diag) + if (CS%id_Kv_v > 0) call post_data(CS%id_Kv_v, Kv_v, CS%diag) + if (CS%id_au_vv > 0) call post_data(CS%id_au_vv, CS%a_u, CS%diag) + if (CS%id_av_vv > 0) call post_data(CS%id_av_vv, CS%a_v, CS%diag) + if (CS%id_h_u > 0) call post_data(CS%id_h_u, CS%h_u, CS%diag) + if (CS%id_h_v > 0) call post_data(CS%id_h_v, CS%h_v, CS%diag) + if (CS%id_hML_u > 0) call post_data(CS%id_hML_u, hML_u, CS%diag) + if (CS%id_hML_v > 0) call post_data(CS%id_hML_v, hML_v, CS%diag) + endif if (allocated(hML_u)) deallocate(hML_u) if (allocated(hML_v)) deallocate(hML_v) @@ -1137,10 +1155,12 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, intent(in) :: h_harm !< Harmonic mean of thicknesses around a velocity !! grid point [H ~> m or kg m-2] real, dimension(SZIB_(G)), intent(in) :: bbl_thick !< Bottom boundary layer thickness [H ~> m or kg m-2] - real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity [Z2 T-1 ~> m2 s-1]. + real, dimension(SZIB_(G)), intent(in) :: kv_bbl !< Bottom boundary layer viscosity, exclusive of + !! any depth-dependent contributions from + !! visc%Kv_shear [Z2 T-1 ~> m2 s-1]. real, dimension(SZIB_(G),SZK_(GV)+1), & intent(in) :: z_i !< Estimate of interface heights above the bottom, - !! normalized by the bottom boundary layer thickness + !! normalized by the bottom boundary layer thickness [nondim] real, dimension(SZIB_(G)), intent(out) :: h_ml !< Mixed layer depth [H ~> m or kg m-2] integer, intent(in) :: j !< j-index to find coupling coefficient for real, intent(in) :: dt !< Time increment [T ~> s] @@ -1159,7 +1179,6 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, u_star, & ! ustar at a velocity point [Z T-1 ~> m s-1]. absf, & ! The average of the neighboring absolute values of f [T-1 ~> s-1]. ! h_ml, & ! The mixed layer depth [H ~> m or kg m-2]. - nk_visc, & ! The (real) interface index of the base of mixed layer. z_t, & ! The distance from the top, sometimes normalized ! by Hmix, [H ~> m or kg m-2] or [nondim]. kv_TBL, & ! The viscosity in a top boundary layer under ice [Z2 T-1 ~> m2 s-1]. @@ -1167,21 +1186,27 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, real, dimension(SZIB_(G),SZK_(GV)+1) :: & Kv_tot, & ! The total viscosity at an interface [Z2 T-1 ~> m2 s-1]. Kv_add ! A viscosity to add [Z2 T-1 ~> m2 s-1]. + integer, dimension(SZIB_(G)) :: & + nk_in_ml ! The index of the deepest interface in the mixed layer. real :: h_shear ! The distance over which shears occur [H ~> m or kg m-2]. - real :: r ! A thickness to compare with Hbbl [H ~> m or kg m-2]. + real :: dhc ! The distance between the center of adjacent layers [H ~> m or kg m-2]. real :: visc_ml ! The mixed layer viscosity [Z2 T-1 ~> m2 s-1]. real :: I_Hmix ! The inverse of the mixed layer thickness [H-1 ~> m-1 or m2 kg-1]. real :: a_ml ! The layer coupling coefficient across an interface in ! the mixed layer [Z T-1 ~> m s-1]. + real :: a_floor ! A lower bound on the layer coupling coefficient across an interface in + ! the mixed layer [Z T-1 ~> m s-1]. real :: I_amax ! The inverse of the maximum coupling coefficient [T Z-1 ~> s m-1]. real :: temp1 ! A temporary variable [H Z ~> m2 or kg m-1] - real :: h_neglect ! A thickness that is so small it is usually lost - ! in roundoff and can be neglected [H ~> m or kg m-2]. + real :: ustar2_denom ! A temporary variable in the surface boundary layer turbulence + ! calculations [Z H-1 T-1 ~> s-1 or m3 kg-1 s-1] + real :: h_neglect ! A thickness that is so small it is usually lost + ! in roundoff and can be neglected [H ~> m or kg m-2]. real :: z2 ! A copy of z_i [nondim] real :: botfn ! A function that is 1 at the bottom and small far from it [nondim] real :: topfn ! A function that is 1 at the top and small far from it [nondim] real :: kv_top ! A viscosity associated with the top boundary layer [Z2 T-1 ~> m2 s-1] - logical :: do_shelf, do_OBCs + logical :: do_shelf, do_OBCs, can_exit integer :: i, k, is, ie, max_nk integer :: nz @@ -1207,36 +1232,33 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, if (associated(OBC)) then ; do_OBCS = (OBC%number_of_segments > 0) ; endif h_ml(:) = 0.0 -! The following loop calculates the vertical average velocity and -! surface mixed layer contributions to the vertical viscosity. + ! This top boundary condition is appropriate when the wind stress is determined + ! externally and does not change within a timestep due to the surface velocity. do i=is,ie ; Kv_tot(i,1) = 0.0 ; enddo - if ((GV%nkml>0) .or. do_shelf) then ; do k=2,nz ; do i=is,ie - if (do_i(i)) Kv_tot(i,K) = CS%Kv - enddo ; enddo ; else + do K=2,nz+1 ; do i=is,ie + Kv_tot(i,K) = CS%Kv + enddo ; enddo + + if ((CS%Kvml_invZ2 > 0.0) .and. .not.do_shelf) then + ! This is an older (vintage ~1997) way to prevent wind stresses from driving very + ! large flows in nearly massless near-surface layers when there is not a physically- + ! based surface boundary layer parameterization. It does not have a plausible + ! physical basis, and probably should not be used. I_Hmix = 1.0 / (CS%Hmix + h_neglect) do i=is,ie ; z_t(i) = h_neglect*I_Hmix ; enddo do K=2,nz ; do i=is,ie ; if (do_i(i)) then z_t(i) = z_t(i) + h_harm(i,k-1)*I_Hmix - Kv_tot(i,K) = CS%Kv + CS%Kvml / ((z_t(i)*z_t(i)) * & + Kv_tot(i,K) = CS%Kv + CS%Kvml_invZ2 / ((z_t(i)*z_t(i)) * & (1.0 + 0.09*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i)*z_t(i))) endif ; enddo ; enddo endif - do i=is,ie ; if (do_i(i)) then - if (CS%bottomdraglaw) then - r = hvel(i,nz)*0.5 - if (r < bbl_thick(i)) then - a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (r+h_neglect)*GV%H_to_Z) - else - a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (bbl_thick(i)+h_neglect)*GV%H_to_Z) - endif - else - a_cpl(i,nz+1) = CS%Kvbbl / ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*CS%Kvbbl) - endif - endif ; enddo - if (associated(visc%Kv_shear)) then - ! The factor of 2 that used to be required in the viscosities is no longer needed. + ! Add in viscosities that are determined by physical processes that are handled in + ! other modules, and which do not respond immediately to the changing layer thicknesses. + ! These processes may include shear-driven mixing or contributions from some boundary + ! layer turbulence schemes. Other viscosity contributions that respond to the evolving + ! layer thicknesses or the surface wind stresses are added later. if (work_on_u) then do K=2,nz ; do i=is,ie ; if (do_i(i)) then Kv_add(i,K) = 0.5*(visc%Kv_shear(i,j,k) + visc%Kv_shear(i+1,j,k)) @@ -1273,6 +1295,9 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif if (associated(visc%Kv_shear_Bu)) then + ! This is similar to what was done above, but for contributions coming from the corner + ! (vorticity) points. Because OBCs run through the faces and corners there is no need + ! to further modify these viscosities here to take OBCs into account. if (work_on_u) then do K=2,nz ; do I=Is,Ie ; If (do_i(I)) then Kv_tot(I,K) = Kv_tot(I,K) + (0.5)*(visc%Kv_shear_Bu(I,J-1,k) + visc%Kv_shear_Bu(I,J,k)) @@ -1284,29 +1309,71 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, endif endif - do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then - ! botfn determines when a point is within the influence of the bottom - ! boundary layer, going from 1 at the bottom to 0 in the interior. - z2 = z_i(i,k) - botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + ! Set the viscous coupling coefficients, excluding surface mixed layer contributions + ! for now, but including viscous bottom drag, working up from the bottom. + if (CS%bottomdraglaw) then + do i=is,ie ; if (do_i(i)) then + dhc = hvel(i,nz)*0.5 + ! These expressions assume that Kv_tot(i,nz+1) = CS%Kv, consistent with + ! the suppression of turbulent mixing by the presence of a solid boundary. + if (dhc < bbl_thick(i)) then + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (dhc+h_neglect)*GV%H_to_Z) + else + a_cpl(i,nz+1) = kv_bbl(i) / (I_amax*kv_bbl(i) + (bbl_thick(i)+h_neglect)*GV%H_to_Z) + endif + endif ; enddo + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then + ! botfn determines when a point is within the influence of the bottom + ! boundary layer, going from 1 at the bottom to 0 in the interior. + z2 = z_i(i,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) - if (CS%bottomdraglaw) then Kv_tot(i,K) = Kv_tot(i,K) + (kv_bbl(i) - CS%Kv)*botfn - r = 0.5*(hvel(i,k) + hvel(i,k-1)) - if (r > bbl_thick(i)) then - h_shear = ((1.0 - botfn) * r + botfn*bbl_thick(i)) + h_neglect + dhc = 0.5*(hvel(i,k) + hvel(i,k-1)) + if (dhc > bbl_thick(i)) then + h_shear = ((1.0 - botfn) * dhc + botfn*bbl_thick(i)) + h_neglect else - h_shear = r + h_neglect + h_shear = dhc + h_neglect endif - else - Kv_tot(i,K) = Kv_tot(i,K) + (CS%Kvbbl-CS%Kv)*botfn + + ! Calculate the coupling coefficients from the viscosities. + a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + endif ; enddo ; enddo ! i & k loops + elseif (abs(CS%Kv_extra_bbl) > 0.0) then + ! There is a simple enhancement of the near-bottom viscosities, but no adjustment + ! of the viscous coupling length scales to give a particular bottom stress. + do i=is,ie ; if (do_i(i)) then + a_cpl(i,nz+1) = (Kv_tot(i,nz+1) + CS%Kv_extra_bbl) / & + ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*(Kv_tot(i,nz+1)+CS%Kv_extra_bbl)) + endif ; enddo + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then + ! botfn determines when a point is within the influence of the bottom + ! boundary layer, going from 1 at the bottom to 0 in the interior. + z2 = z_i(i,k) + botfn = 1.0 / (1.0 + 0.09*z2*z2*z2*z2*z2*z2) + + Kv_tot(i,K) = Kv_tot(i,K) + CS%Kv_extra_bbl*botfn h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) - endif - ! Calculate the coupling coefficients from the viscosities. - a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) - endif ; enddo ; enddo ! i & k loops + ! Calculate the coupling coefficients from the viscosities. + a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + endif ; enddo ; enddo ! i & k loops + else + ! Any near-bottom viscous enhancements were already incorporated into Kv_tot, and there is + ! no adjustment of the viscous coupling length scales to give a particular bottom stress. + do i=is,ie ; if (do_i(i)) then + a_cpl(i,nz+1) = Kv_tot(i,nz+1) / ((0.5*hvel(i,nz)+h_neglect)*GV%H_to_Z + I_amax*Kv_tot(i,nz+1)) + endif ; enddo + do K=nz,2,-1 ; do i=is,ie ; if (do_i(i)) then + h_shear = 0.5*(hvel(i,k) + hvel(i,k-1) + h_neglect) + ! Calculate the coupling coefficients from the viscosities. + a_cpl(i,K) = Kv_tot(i,K) / (h_shear*GV%H_to_Z + I_amax*Kv_tot(i,K)) + endif ; enddo ; enddo ! i & k loops + endif + ! Add surface intensified viscous coupling, either as a no-slip boundary condition under a + ! rigid ice-shelf, or due to wind-stress driven surface boundary layer mixing that has not + ! already been added via visc%Kv_shear. if (do_shelf) then ! Set the coefficients to include the no-slip surface stress. do i=is,ie ; if (do_i(i)) then @@ -1331,68 +1398,165 @@ subroutine find_coupling_coef(a_cpl, hvel, do_i, h_harm, bbl_thick, kv_bbl, z_i, z_t(i) = z_t(i) + hvel(i,k-1) / tbl_thick(i) topfn = 1.0 / (1.0 + 0.09 * z_t(i)**6) - r = 0.5*(hvel(i,k)+hvel(i,k-1)) - if (r > tbl_thick(i)) then - h_shear = ((1.0 - topfn) * r + topfn*tbl_thick(i)) + h_neglect + dhc = 0.5*(hvel(i,k)+hvel(i,k-1)) + if (dhc > tbl_thick(i)) then + h_shear = ((1.0 - topfn) * dhc + topfn*tbl_thick(i)) + h_neglect else - h_shear = r + h_neglect + h_shear = dhc + h_neglect endif kv_top = topfn * kv_TBL(i) a_cpl(i,K) = a_cpl(i,K) + kv_top / (h_shear*GV%H_to_Z + I_amax*kv_top) endif ; enddo ; enddo - elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0)) then - max_nk = 0 - do i=is,ie ; if (do_i(i)) then - if (GV%nkml>0) nk_visc(i) = real(GV%nkml+1) - if (work_on_u) then + + elseif (CS%dynamic_viscous_ML .or. (GV%nkml>0) .or. CS%fixed_LOTW_ML .or. CS%apply_LOTW_floor) then + + ! Find the friction velocity and the absolute value of the Coriolis parameter at this point. + u_star(:) = 0.0 ! Zero out the friction velocity on land points. + if (work_on_u) then + do I=is,ie ; if (do_i(I)) then u_star(I) = 0.5*(forces%ustar(i,j) + forces%ustar(i+1,j)) absf(I) = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) - if (CS%dynamic_viscous_ML) nk_visc(I) = visc%nkml_visc_u(I,j) + 1 - else - u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) - absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) - if (CS%dynamic_viscous_ML) nk_visc(i) = visc%nkml_visc_v(i,J) + 1 - endif - h_ml(i) = h_neglect ; z_t(i) = 0.0 - max_nk = max(max_nk,ceiling(nk_visc(i) - 1.0)) - endif ; enddo - - if (do_OBCS) then ; if (work_on_u) then - do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then + endif ; enddo + if (do_OBCs) then ; do I=is,ie ; if (do_i(I) .and. (OBC%segnum_u(I,j) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) & u_star(I) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) & u_star(I) = forces%ustar(i+1,j) - endif ; enddo + endif ; enddo ; endif else - do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then + do i=is,ie ; if (do_i(i)) then + u_star(i) = 0.5*(forces%ustar(i,j) + forces%ustar(i,j+1)) + absf(i) = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + endif ; enddo + if (do_OBCs) then ; do i=is,ie ; if (do_i(i) .and. (OBC%segnum_v(i,J) /= OBC_NONE)) then if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) & u_star(i) = forces%ustar(i,j) if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) & u_star(i) = forces%ustar(i,j+1) + endif ; enddo ; endif + endif + + ! Determine the thickness of the surface ocean boundary layer and its extent in index space. + nk_in_ml(:) = 0 + if (CS%dynamic_viscous_ML) then + ! The fractional number of layers that are within the viscous boundary layer were + ! previously stored in visc%nkml_visc_[uv]. + h_ml(:) = h_neglect + max_nk = 0 + if (work_on_u) then + do i=is,ie ; if (do_i(i)) then + nk_in_ml(I) = ceiling(visc%nkml_visc_u(I,j)) + max_nk = max(max_nk, nk_in_ml(I)) + endif ; enddo + do k=1,max_nk ; do i=is,ie ; if (do_i(i)) then + if (k <= visc%nkml_visc_u(I,j)) then ! This layer is all in the ML. + h_ml(i) = h_ml(i) + hvel(i,k) + elseif (k < visc%nkml_visc_u(I,j) + 1.0) then ! Part of this layer is in the ML. + h_ml(i) = h_ml(i) + ((visc%nkml_visc_u(I,j) + 1.0) - k) * hvel(i,k) + endif + endif ; enddo ; enddo + else + do i=is,ie ; if (do_i(i)) then + nk_in_ml(i) = ceiling(visc%nkml_visc_v(i,J)) + max_nk = max(max_nk, nk_in_ml(i)) + endif ; enddo + do k=1,max_nk ; do i=is,ie ; if (do_i(i)) then + if (k <= visc%nkml_visc_v(i,J)) then ! This layer is all in the ML. + h_ml(i) = h_ml(i) + hvel(i,k) + elseif (k < visc%nkml_visc_v(i,J) + 1.0) then ! Part of this layer is in the ML. + h_ml(i) = h_ml(i) + ((visc%nkml_visc_v(i,J) + 1.0) - k) * hvel(i,k) + endif + endif ; enddo ; enddo + endif + + elseif (GV%nkml>0) then + ! This is a simple application of a refined-bulk mixed layer with GV%nkml sublayers. + max_nk = GV%nkml + do i=is,ie ; if (do_i(i)) then + nk_in_ml(i) = GV%nkml endif ; enddo - endif ; endif - do k=1,max_nk ; do i=is,ie ; if (do_i(i)) then - if (k+1 <= nk_visc(i)) then ! This layer is all in the ML. + h_ml(:) = h_neglect + do k=1,GV%nkml ; do i=is,ie ; if (do_i(i)) then h_ml(i) = h_ml(i) + hvel(i,k) - elseif (k < nk_visc(i)) then ! Part of this layer is in the ML. - h_ml(i) = h_ml(i) + (nk_visc(i) - k) * hvel(i,k) - endif - endif ; enddo ; enddo + endif ; enddo ; enddo + elseif (CS%fixed_LOTW_ML .or. CS%apply_LOTW_floor) then + ! Determine which interfaces are within CS%Hmix of the surface, and set the viscous + ! boundary layer thickness to the the smaller of CS%Hmix and the depth of the ocean. + h_ml(:) = 0.0 + do k=1,nz + can_exit = .true. + do i=is,ie ; if (do_i(i) .and. (h_ml(i) < CS%Hmix)) then + nk_in_ml(i) = k + if (h_ml(i) + hvel(i,k) < CS%Hmix) then + h_ml(i) = h_ml(i) + hvel(i,k) + can_exit = .false. ! Part of the next deeper layer is also in the mixed layer. + else + h_ml(i) = CS%Hmix + endif + endif ; enddo + if (can_exit) exit ! All remaining layers in this row are below the mixed layer depth. + enddo + max_nk = 0 + do i=is,ie ; max_nk = max(max_nk, nk_in_ml(i)) ; enddo + endif - do K=2,max_nk ; do i=is,ie ; if (do_i(i)) then ; if (k < nk_visc(i)) then - ! Set the viscosity at the interfaces. - z_t(i) = z_t(i) + hvel(i,k-1) - temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z - ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) - ! and be further limited by rotation to give the natural Ekman length. - visc_ml = u_star(i) * 0.41 * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) - a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) - ! Choose the largest estimate of a. - if (a_ml > a_cpl(i,K)) a_cpl(i,K) = a_ml - endif ; endif ; enddo ; enddo + ! Avoid working on land or on columns where the viscous coupling could not be increased. + do i=is,ie ; if ((u_star(i)<=0.0) .or. (.not.do_i(i))) nk_in_ml(i) = 0 ; enddo + + ! Set the viscous coupling at the interfaces as the larger of what was previously + ! set and the contributions from the surface boundary layer. + z_t(:) = 0.0 + if (CS%apply_LOTW_floor .and. & + (CS%dynamic_viscous_ML .or. (GV%nkml>0) .or. CS%fixed_LOTW_ML)) then + do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then + z_t(i) = z_t(i) + hvel(i,k-1) + + ! The viscosity in visc_ml is set to go to 0 at the mixed layer top and bottom + ! (in a log-layer) and be further limited by rotation to give the natural Ekman length. + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + visc_ml = temp1 * ustar2_denom + ! Set the viscous coupling based on the model's vertical resolution. The omission of + ! the I_amax factor here is consistent with answer dates above 20190101. + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z) + + ! As a floor on the viscous coupling, assume that the length scale in the denominator can + ! not be larger than the distance from the surface, consistent with a logarithmic velocity + ! profile. This is consistent with visc_ml, but cancels out common factors of z_t. + a_floor = (h_ml(i) - z_t(i)) * ustar2_denom + + ! Choose the largest estimate of a_cpl. + a_cpl(i,K) = max(a_cpl(i,K), a_ml, a_floor) + ! An option could be added to change this to: a_cpl(i,K) = max(a_cpl(i,K) + a_ml, a_floor) + endif ; enddo ; enddo + elseif (CS%apply_LOTW_floor) then + do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then + z_t(i) = z_t(i) + hvel(i,k-1) + + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ustar2_denom = (CS%vonKar * u_star(i)**2) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + + ! As a floor on the viscous coupling, assume that the length scale in the denominator can not + ! be larger than the distance from the surface, consistent with a logarithmic velocity profile. + a_cpl(i,K) = max(a_cpl(i,K), (h_ml(i) - z_t(i)) * ustar2_denom) + endif ; enddo ; enddo + else + do K=2,max_nk ; do i=is,ie ; if (k <= nk_in_ml(i)) then + z_t(i) = z_t(i) + hvel(i,k-1) + + temp1 = (z_t(i)*h_ml(i) - z_t(i)*z_t(i))*GV%H_to_Z + ! This viscosity is set to go to 0 at the mixed layer top and bottom (in a log-layer) + ! and be further limited by rotation to give the natural Ekman length. + visc_ml = u_star(i) * CS%vonKar * (temp1*u_star(i)) / (absf(i)*temp1 + (h_ml(i)+h_neglect)*u_star(i)) + a_ml = visc_ml / (0.25*(hvel(i,k)+hvel(i,k-1) + h_neglect) * GV%H_to_Z + 0.5*I_amax*visc_ml) + + ! Choose the largest estimate of a_cpl, but these could be changed to be additive. + a_cpl(i,K) = max(a_cpl(i,K), a_ml) + ! An option could be added to change this to: a_cpl(i,K) = a_cpl(i,K) + a_ml + endif ; enddo ; enddo + endif endif end subroutine find_coupling_coef @@ -1625,7 +1789,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & ! Local variables - real :: Kv_dflt ! A default viscosity [m2 s-1]. + real :: Kv_BBL ! A viscosity in the bottom boundary layer with a simple scheme [Z2 T-1 ~> m2 s-1]. real :: Hmix_m ! A boundary layer thickness [m]. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. logical :: default_2018_answers ! The default setting for the various 2018_ANSWERS flags. @@ -1687,23 +1851,38 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "actual velocity in the bottommost HBBL, depending on "//& "LINEAR_DRAG.", default=.true.) call get_param(param_file, mdl, "DIRECT_STRESS", CS%direct_stress, & - "If true, the wind stress is distributed over the "//& - "topmost HMIX_STRESS of fluid (like in HYCOM), and KVML "//& - "may be set to a very small value.", default=.false.) + "If true, the wind stress is distributed over the topmost HMIX_STRESS of fluid "//& + "(like in HYCOM), and an added mixed layer viscosity or a physically based "//& + "boundary layer turbulence parameterization is not needed for stability.", & + default=.false.) call get_param(param_file, mdl, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & "If true, use a bulk Richardson number criterion to "//& "determine the mixed layer thickness for viscosity.", & default=.false.) + call get_param(param_file, mdl, "FIXED_DEPTH_LOTW_ML", CS%fixed_LOTW_ML, & + "If true, use a Law-of-the-wall prescription for the mixed layer viscosity "//& + "within a boundary layer that is the lesser of HMIX_FIXED and the total "//& + "depth of the ocean in a column.", default=.false.) + call get_param(param_file, mdl, "LOTW_VISCOUS_ML_FLOOR", CS%apply_LOTW_floor, & + "If true, use a Law-of-the-wall prescription to set a lower bound on the "//& + "viscous coupling between layers within the surface boundary layer, based "//& + "the distance of interfaces from the surface. This only acts when there "//& + "are large changes in the thicknesses of successive layers or when the "//& + "viscosity is set externally and the wind stress has subsequently increased.", & + default=.false.) + call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & + 'The value the von Karman constant as used for mixed layer viscosity.', & + units='nondim', default=0.41) call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & "The absolute path to a file into which the accelerations "//& "leading to zonal velocity truncations are written. "//& - "Undefine this for efficiency if this diagnostic is not "//& - "needed.", default=" ", debuggingParam=.true.) + "Undefine this for efficiency if this diagnostic is not needed.", & + default=" ", debuggingParam=.true.) call get_param(param_file, mdl, "V_TRUNC_FILE", CS%v_trunc_file, & "The absolute path to a file into which the accelerations "//& "leading to meridional velocity truncations are written. "//& - "Undefine this for efficiency if this diagnostic is not "//& - "needed.", default=" ", debuggingParam=.true.) + "Undefine this for efficiency if this diagnostic is not needed.", & + default=" ", debuggingParam=.true.) call get_param(param_file, mdl, "HARMONIC_VISC", CS%harmonic_visc, & "If true, use the harmonic mean thicknesses for "//& "calculating the vertical viscosity.", default=.false.) @@ -1724,12 +1903,12 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & if (CS%direct_stress) then if (GV%nkml < 1) then call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & - "The depth over which the wind stress is applied if "//& - "DIRECT_STRESS is true.", units="m", default=Hmix_m, scale=GV%m_to_H) + "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & + units="m", default=Hmix_m, scale=GV%m_to_H) else call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & - "The depth over which the wind stress is applied if "//& - "DIRECT_STRESS is true.", units="m", fail_if_missing=.true., scale=GV%m_to_H) + "The depth over which the wind stress is applied if DIRECT_STRESS is true.", & + units="m", fail_if_missing=.true., scale=GV%m_to_H) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") @@ -1737,30 +1916,68 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. "//& "The molecular value, ~1e-6 m2 s-1, may be used.", & - units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T, unscaled=Kv_dflt) - - if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & - "The kinematic viscosity in the mixed layer. A typical "//& - "value is ~1e-2 m2 s-1. KVML is not used if "//& - "BULKMIXEDLAYER is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) - if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & - "The kinematic viscosity in the benthic boundary layer. "//& - "A typical value is ~1e-2 m2 s-1. KVBBL is not used if "//& - "BOTTOMDRAGLAW is true. The default is set by KV.", & - units="m2 s-1", default=Kv_dflt, scale=US%m2_s_to_Z2_T) + units="m2 s-1", fail_if_missing=.true., scale=US%m2_s_to_Z2_T) + + CS%Kvml_invZ2 = 0.0 + if (GV%nkml < 1) then + call get_param(param_file, mdl, "KV_ML_INVZ2", CS%Kvml_invZ2, & + "An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//& + "with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//& + "distance from the surface, to allow for finite wind stresses to be "//& + "transmitted through infinitesimally thin surface layers. This is an "//& + "older option for numerical convenience without a strong physical basis, "//& + "and its use is now discouraged.", & + units="m2 s-1", default=-1.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (CS%Kvml_invZ2 < 0.0) then + call get_param(param_file, mdl, "KVML", CS%Kvml_invZ2, & + "The scale for an extra kinematic viscosity in the mixed layer", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (CS%Kvml_invZ2 >= 0.0) & + call MOM_error(WARNING, "KVML is a deprecated parameter. Use KV_ML_INVZ2 instead.") + endif + if (CS%Kvml_invZ2 < 0.0) CS%Kvml_invZ2 = 0.0 + call log_param(param_file, mdl, "KV_ML_INVZ2", US%Z2_T_to_m2_s*CS%Kvml_invZ2, & + "An extra kinematic viscosity in a mixed layer of thickness HMIX_FIXED, "//& + "with the actual viscosity scaling as 1/(z*HMIX_FIXED)^2, where z is the "//& + "distance from the surface, to allow for finite wind stresses to be "//& + "transmitted through infinitesimally thin surface layers. This is an "//& + "older option for numerical convenience without a strong physical basis, "//& + "and its use is now discouraged.", & + units="m2 s-1", default=0.0) + endif + + if (.not.CS%bottomdraglaw) then + call get_param(param_file, mdl, "KV_EXTRA_BBL", CS%Kv_extra_bbl, & + "An extra kinematic viscosity in the benthic boundary layer. "//& + "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & + units="m2 s-1", default=0.0, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (CS%Kv_extra_bbl == 0.0) then + call get_param(param_file, mdl, "KVBBL", Kv_BBL, & + "An extra kinematic viscosity in the benthic boundary layer. "//& + "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & + units="m2 s-1", default=US%Z2_T_to_m2_s*CS%Kv, scale=US%m2_s_to_Z2_T, do_not_log=.true.) + if (abs(Kv_BBL - CS%Kv) > 1.0e-15*abs(CS%Kv)) then + call MOM_error(WARNING, "KVBBL is a deprecated parameter. Use KV_EXTRA_BBL instead.") + CS%Kv_extra_bbl = Kv_BBL - CS%Kv + endif + endif + call log_param(param_file, mdl, "KV_EXTRA_BBL", US%Z2_T_to_m2_s*CS%Kv_extra_bbl, & + "An extra kinematic viscosity in the benthic boundary layer. "//& + "KV_EXTRA_BBL is not used if BOTTOMDRAGLAW is true.", & + units="m2 s-1", default=0.0) + endif call get_param(param_file, mdl, "HBBL", CS%Hbbl, & - "The thickness of a bottom boundary layer with a "//& - "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or "//& - "the thickness over which near-bottom velocities are "//& - "averaged for the drag law if BOTTOMDRAGLAW is defined "//& - "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true., scale=GV%m_to_H) + "The thickness of a bottom boundary layer with a viscosity increased by "//& + "KV_EXTRA_BBL if BOTTOMDRAGLAW is not defined, or the thickness over which "//& + "near-bottom velocities are averaged for the drag law if BOTTOMDRAGLAW is "//& + "defined but LINEAR_DRAG is not.", & + units="m", fail_if_missing=.true., scale=GV%m_to_H) call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & - "The maximum velocity allowed before the velocity "//& - "components are truncated.", units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) + "The maximum velocity allowed before the velocity components are truncated.", & + units="m s-1", default=3.0e8, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & - "If true, base truncations on the CFL number, and not an "//& - "absolute speed.", default=.true.) + "If true, base truncations on the CFL number, and not an absolute speed.", & + default=.true.) call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, & "The value of the CFL number that will cause velocity "//& "components to be truncated; instability can occur past 0.5.", & @@ -1782,7 +1999,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, US, param_file, diag, ADp, dirs, & "Flag to use Stokes drift Mixing via the Lagrangian "//& " current (Eulerian plus Stokes drift). "//& " Still needs work and testing, so not recommended for use.",& - Default=.false.) + default=.false.) !BGR 04/04/2018{ ! StokesMixing is required for MOM6 for some Langmuir mixing parameterization. ! The code used here has not been developed for vanishing layers or in diff --git a/src/parameterizations/vertical/_CVMix_KPP.dox b/src/parameterizations/vertical/_CVMix_KPP.dox index 7a65b6a6a3..72c166c284 100644 --- a/src/parameterizations/vertical/_CVMix_KPP.dox +++ b/src/parameterizations/vertical/_CVMix_KPP.dox @@ -7,7 +7,7 @@ The formulation and implementation of KPP is described in great detail in the [CVMix manual](https://github.com/CVMix/CVMix-description/raw/master/cvmix.pdf) (written by our own Steve Griffies). - \section section_KPP_nutshell KPP in a nutshell + \section section_KPP_nutshell KPP in a nutshell Large et al., \cite large1994, decompose the parameterized boundary layer turbulent flux of a scalar, \f$ s \f$, as \f[ \overline{w^\prime s^\prime} = -K \partial_z s + K \gamma_s(\sigma), \f] diff --git a/src/parameterizations/vertical/_V_diffusivity.dox b/src/parameterizations/vertical/_V_diffusivity.dox index f3b7ed5962..df1ce50e27 100644 --- a/src/parameterizations/vertical/_V_diffusivity.dox +++ b/src/parameterizations/vertical/_V_diffusivity.dox @@ -253,26 +253,6 @@ in \cite harrison2008, but that isn't what is in the MOM6 code. Instead, the sur value is propagated down, with the assumption that the tidal mixing parameterization will provide the deep mixing: \ref section_Internal_Tidal_Mixing. -There is also a "new" Henyey version, taking into account the effect of stratification on -TKE dissipation, - -\todo Harrison (personal communication) recommends that this option be made obsolete and -eventually removed. - -\f[ - \epsilon = \epsilon_0 \frac{f}{f_0} \frac{\mbox{acosh} (N/f)}{\mbox{acosh} (N_0 / f_0)} -\f] - -where \f$N_0\f$ and \f$f_0\f$ are the reference buoyancy frequency and inertial frequencies, respectively -and \f$\epsilon_0\f$ is the reference dissipation at \f$(N_0, f_0)\f$. In the previous version, \f$N = -N_0\f$. Additionally, the relationship between diapycnal diffusivities and stratification is included: - -\f[ - \kappa = \frac{\epsilon}{N^2} -\f] -This approach assumes that work done against gravity is uniformly distributed throughout the water column. -The original version concentrates buoyancy work in regions of strong stratification. - \subsection subsection_danabasoglu_back Danabasoglu background mixing The shape of the \cite danabasoglu2012 background mixing has a uniform background value, with a dip diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index c1582dca4a..bf06fc294e 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -4,7 +4,9 @@ module MOM_offline_main ! This file is part of MOM6. See LICENSE.md for the license. -use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_inputs +use MOM_ALE, only : ALE_CS, ALE_regrid, ALE_offline_inputs +use MOM_ALE, only : pre_ALE_adjustments, ALE_update_regrid_weights +use MOM_ALE, only : ALE_remap_tracers use MOM_checksums, only : hchksum, uvchksum use MOM_coms, only : reproducing_sum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end @@ -118,7 +120,7 @@ module MOM_offline_main real :: minimum_forcing_depth !< The smallest depth over which fluxes can be applied [H ~> m or kg m-2]. !! This is copied from diabatic_CS controlling how tracers follow freshwater fluxes - real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity + real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity [Z2 T-1 ~> m2 s-1] real :: min_residual !< The minimum amount of total mass flux before exiting the main advection !! routine [H L2 ~> m3 or kg] !>@{ Diagnostic manager IDs for some fields that may be of interest when doing offline transport @@ -169,8 +171,6 @@ module MOM_offline_main real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep [H ~> m or kg m-2] - real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean - real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points [Z ~> m] ! Allocatable arrays to read in entire fields during initialization @@ -229,7 +229,10 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C ! Variables used to keep track of layer thicknesses at various points in the code real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & h_new, & ! Updated layer thicknesses [H ~> m or kg m-2] + h_post_remap, & ! Layer thicknesses after remapping [H ~> m or kg m-2] h_vol ! Layer volumes [H L2 ~> m3 or kg] + real :: dzRegrid(SZI_(G),SZJ_(G),SZK_(GV)+1) ! The change in grid interface positions due to regridding, + ! in the same units as thicknesses [H ~> m or kg m-2] integer :: niter, iter real :: Inum_iter ! The inverse of the number of iterations [nondim] character(len=256) :: mesg ! The text of an error message @@ -347,7 +350,23 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, G, GV, US, C call MOM_tracer_chkinv(debug_msg, G, GV, h_new, CS%tracer_reg) endif call cpu_clock_begin(id_clock_ALE) - call ALE_main_offline(G, GV, h_new, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%OBC, CS%dt_offline) + + call ALE_update_regrid_weights(CS%dt_offline, CS%ALE_CSp) + call pre_ALE_adjustments(G, GV, US, h_new, CS%tv, CS%tracer_Reg, CS%ALE_CSp) + ! Uncomment this to adjust the target grids for diagnostics, if there have been thickness + ! adjustments, but the offline tracer code does not yet have the other corresponding calls + ! that would be needed to support remapping its output. + ! call diag_update_remap_grids(CS%diag, alt_h=h_new) + + call ALE_regrid(G, GV, US, h_new, h_post_remap, dzRegrid, CS%tv, CS%ALE_CSp) + + ! Remap all variables from the old grid h_new onto the new grid h_post_remap + call ALE_remap_tracers(CS%ALE_CSp, G, GV, h_new, h_post_remap, CS%tracer_Reg, & + CS%debug, dt=CS%dt_offline) + + do k=1,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + h_new(i,j,k) = h_post_remap(i,j,k) + enddo ; enddo ; enddo call cpu_clock_end(id_clock_ALE) if (CS%debug) then @@ -746,6 +765,7 @@ subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: in_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater + !! [CU H ~> Conc m or Conc kg m-2] integer :: i, j, m real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes [H ~> m or kg m-2] @@ -796,6 +816,7 @@ subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) real, dimension(SZI_(G),SZJ_(G)), & optional, intent(in) :: out_flux_optional !< The total time-integrated amount !! of tracer that leaves with freshwater + !! [CU H ~> Conc m or Conc kg m-2] integer :: m logical :: update_h !< Flag for whether h should be updated @@ -1444,8 +1465,6 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) allocate(CS%eatr(isd:ied,jsd:jed,nz), source=0.0) allocate(CS%ebtr(isd:ied,jsd:jed,nz), source=0.0) allocate(CS%h_end(isd:ied,jsd:jed,nz), source=0.0) - allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed), source=0.0) - allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed), source=0.0) allocate(CS%Kd(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) @@ -1518,8 +1537,6 @@ subroutine offline_transport_end(CS) deallocate(CS%eatr) deallocate(CS%ebtr) deallocate(CS%h_end) - deallocate(CS%netMassOut) - deallocate(CS%netMassIn) deallocate(CS%Kd) if (CS%read_mld) deallocate(CS%mld) if (CS%read_all_ts_uvh) then diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 6801269245..9ceadc602d 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -231,7 +231,7 @@ subroutine initialize_RGC_tracer(restart, day, G, GV, h, diag, OBC, CS, & do m=1,1 ! This is needed to force the compiler not to do a copy in the sponge calls. tr_ptr => CS%tr(:,:,:,m) - call set_up_ALE_sponge_field(temp, G, GV, tr_ptr, sponge_CSp) + call set_up_ALE_sponge_field(temp, G, GV, tr_ptr, sponge_CSp, 'RGC_tracer') enddo deallocate(temp) endif diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index d0ed88c128..a997cde26b 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -473,12 +473,10 @@ subroutine DOME2d_initialize_sponges(G, GV, US, tv, depth_tot, param_file, use_A enddo enddo ; enddo - if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) - endif - if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) - endif + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & + sp_long_name='temperature', sp_unit='degC s-1') + if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') else diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 5e91eaa86a..aaededaa8c 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -626,12 +626,11 @@ subroutine ISOMIP_initialize_sponges(G, GV, US, tv, depth_tot, PF, use_ALE, CSp, ! momentum is typically not damped within the sponge. ! ! The remaining calls to set_up_sponge_field can be in any order. ! - if ( associated(tv%T) ) then - call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) - endif - if ( associated(tv%S) ) then - call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) - endif + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & + sp_long_name='temperature', sp_unit='degC s-1') + if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') + else ! layer mode ! 1) Read eta, salt and temp from IC file diff --git a/src/user/RGC_initialization.F90 b/src/user/RGC_initialization.F90 index d9c1846a0e..b56e0b895a 100644 --- a/src/user/RGC_initialization.F90 +++ b/src/user/RGC_initialization.F90 @@ -168,8 +168,10 @@ subroutine RGC_initialize_sponges(G, GV, US, tv, u, v, depth_tot, PF, use_ALE, C call initialize_ALE_sponge(Idamp, G, GV, PF, ACSp, h, nz) ! The remaining calls to set_up_sponge_field can be in any order. - if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) - if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & + sp_long_name='temperature', sp_unit='degC s-1') + if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') if (sponge_uv) then U1(:,:,:) = 0.0 ; V1(:,:,:) = 0.0 diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index fa44a78604..a81c400256 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -279,8 +279,10 @@ subroutine dense_water_initialize_sponges(G, GV, US, tv, depth_tot, param_file, enddo enddo - if (associated(tv%T)) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp) - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) + if ( associated(tv%T) ) call set_up_ALE_sponge_field(T, G, GV, tv%T, ACSp, 'temp', & + sp_long_name='temperature', sp_unit='degC s-1') + if ( associated(tv%S) ) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') else call MOM_error(FATAL, "dense_water_initialize_sponges: trying to use non ALE sponge") endif diff --git a/src/user/dumbbell_initialization.F90 b/src/user/dumbbell_initialization.F90 index e4ce7e77f5..762477b6c4 100644 --- a/src/user/dumbbell_initialization.F90 +++ b/src/user/dumbbell_initialization.F90 @@ -446,12 +446,13 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil enddo endif enddo ; enddo - if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp) + if (associated(tv%S)) call set_up_ALE_sponge_field(S, G, GV, tv%S, ACSp, 'salt', & + sp_long_name='salinity', sp_unit='g kg-1 s-1') else do j=G%jsc,G%jec ; do i=G%isc,G%iec eta(i,j,1) = 0.0 do k=2,nz - eta(i,j,k) = eta(i,j,k-1)- GV%H_to_Z * h_in(i,j,k-1) + eta(i,j,k) = eta(i,j,k-1) - GV%H_to_Z * h_in(i,j,k-1) enddo eta(i,j,nz+1) = -depth_tot(i,j) do k=1,nz @@ -469,4 +470,4 @@ subroutine dumbbell_initialize_sponges(G, GV, US, tv, h_in, depth_tot, param_fil end subroutine dumbbell_initialize_sponges -end module dumbbell_initialization +end module dumbbell_initialization \ No newline at end of file