From b32aea7bf3f9e2a774afa23d3386c88156cd1182 Mon Sep 17 00:00:00 2001 From: Daniel Sarmiento <42810219+dpsarmie@users.noreply.github.com> Date: Tue, 21 May 2024 13:46:30 -0400 Subject: [PATCH 01/21] Add end of run restart functionality to MOM6 (#133) * Update mom_cap.F90 to add end of run restart file functionality controlled by write_restart_at_endofrun configuration option in CMEPS. Author: Daniel Sarmient --- config_src/drivers/nuopc_cap/mom_cap.F90 | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index 3574943918..d2dcf96067 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -136,6 +136,7 @@ module MOM_cap_mod logical :: grid_attach_area = .false. logical :: use_coldstart = .true. logical :: use_mommesh = .true. +logical :: restart_eor = .false. character(len=128) :: scalar_field_name = '' integer :: scalar_field_count = 0 integer :: scalar_field_idx_grid_nx = 0 @@ -381,6 +382,12 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) geomtype = ESMF_GEOMTYPE_GRID endif + ! Read end of run restart config option + call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=value, isPresent=isPresent, isSet=isSet, rc=rc) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (isPresent .and. isSet) then + if (trim(value) .eq. '.true.') restart_eor = .true. + end if end subroutine @@ -1637,6 +1644,8 @@ subroutine ModelAdvance(gcomp, rc) real(8) :: MPI_Wtime, timers logical :: write_restart logical :: write_restartfh + logical :: write_restart_eor + rc = ESMF_SUCCESS if(profile_memory) call ESMF_VMLogMemInfo("Entering MOM Model_ADVANCE: ") @@ -1776,7 +1785,6 @@ subroutine ModelAdvance(gcomp, rc) !--------------- ! Get the stop alarm !--------------- - call ESMF_ClockGetAlarm(clock, alarmname='stop_alarm', alarm=stop_alarm, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -1807,7 +1815,18 @@ subroutine ModelAdvance(gcomp, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return end if - if (write_restart .or. write_restartfh) then + write_restart_eor = .false. + if (restart_eor) then + if (ESMF_AlarmIsRinging(stop_alarm, rc=rc)) then + if (ChkErr(rc,__LINE__,u_FILE_u)) return + write_restart_eor = .true. + ! turn off the alarm + call ESMF_AlarmRingerOff(stop_alarm, rc=rc ) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + end if + end if + + if (write_restart .or. write_restartfh .or. write_restart_eor) then ! determine restart filename call ESMF_ClockGetNextTime(clock, MyTime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return From bfe3e4f03d2795b42d557a2ebe2713f6cee3bff3 Mon Sep 17 00:00:00 2001 From: jiandewang Date: Wed, 22 May 2024 15:51:27 -0400 Subject: [PATCH 02/21] fix line length too long issue in mom_cap.F90 --- config_src/drivers/nuopc_cap/mom_cap.F90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index d2dcf96067..3e3abba674 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -383,7 +383,8 @@ subroutine InitializeP0(gcomp, importState, exportState, clock, rc) endif ! Read end of run restart config option - call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=value, isPresent=isPresent, isSet=isSet, rc=rc) + call NUOPC_CompAttributeGet(gcomp, name="write_restart_at_endofrun", value=value, & + isPresent=isPresent, isSet=isSet, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return if (isPresent .and. isSet) then if (trim(value) .eq. '.true.') restart_eor = .true. From 8ecb2603119b8c9d4dee9ee6b174e1864415d1cc Mon Sep 17 00:00:00 2001 From: Marshall Ward Date: Tue, 28 May 2024 14:48:54 -0400 Subject: [PATCH 03/21] CI: Fix FMS_COMMIT, remove FRAMEWORK This patch fixes FMS_COMMIT and FMS_URL so that they are properly exported to ``ac/deps/Makefile`` and used in the .testing FMS build. It also removes any references to the FRAMEWORK flag, which is no longer needed to identify the FMS API. --- .github/workflows/macos-regression.yml | 1 - .github/workflows/macos-stencil.yml | 1 - .testing/Makefile | 8 +++++--- .testing/README.rst | 8 +++++--- 4 files changed, 10 insertions(+), 8 deletions(-) diff --git a/.github/workflows/macos-regression.yml b/.github/workflows/macos-regression.yml index 5e0380bcd2..d769e15131 100644 --- a/.github/workflows/macos-regression.yml +++ b/.github/workflows/macos-regression.yml @@ -11,7 +11,6 @@ jobs: CC: gcc FC: gfortran FMS_COMMIT: 2019.01.03 - FRAMEWORK: fms1 defaults: run: diff --git a/.github/workflows/macos-stencil.yml b/.github/workflows/macos-stencil.yml index e54912b607..6e77a5c4a6 100644 --- a/.github/workflows/macos-stencil.yml +++ b/.github/workflows/macos-stencil.yml @@ -11,7 +11,6 @@ jobs: CC: gcc FC: gfortran FMS_COMMIT: 2019.01.03 - FRAMEWORK: fms1 defaults: run: diff --git a/.testing/Makefile b/.testing/Makefile index 8ca3fe21eb..f5da44342d 100644 --- a/.testing/Makefile +++ b/.testing/Makefile @@ -20,7 +20,6 @@ # # General test configuration: # MPIRUN MPI job launcher (mpirun, srun, etc) -# FRAMEWORK Model framework (fms1 or fms2) # DO_REPRO_TESTS Enable production ("repro") testing equivalence # DO_REGRESSION_TESTS Enable regression tests (usually dev/gfdl) # DO_COVERAGE Enable code coverage and generate .gcov reports @@ -74,8 +73,11 @@ AC_SRCDIR := $(dir $(abspath $(lastword $(MAKEFILE_LIST))))../ac # User-defined configuration -include config.mk -# Set the infra framework -FRAMEWORK ?= fms2 +# Set the FMS library +FMS_COMMIT ?= 2023.03 +FMS_URL ?= https://github.com/NOAA-GFDL/FMS.git +export FMS_COMMIT +export FMS_URL # Set the MPI launcher here # TODO: This needs more automated configuration diff --git a/.testing/README.rst b/.testing/README.rst index 49103da718..a84eeea80e 100644 --- a/.testing/README.rst +++ b/.testing/README.rst @@ -47,9 +47,11 @@ Several of the following may require configuration for particular systems. Name of the MPI launcher. Often this is ``mpirun`` or ``mpiexec`` but may all need to run through a scheduler, e.g. ``srun`` if using Slurm. -``FRAMEWORK`` (*default:* ``fms1``) - Select either the legacy FMS framework (``fms1``) or an FMS2 I/O compatible - version (``fms2``). +``FMS_COMMIT`` (*default:* ``2023.03``) + Set the FMS version, either by tag or commit (as defined in ``FMS_URL``). + +``FMS_URL`` (*default*: ``https://github.com/NOAA-GFDL/FMS.git``) + Set the URL of the FMS repository. ``DO_REPRO_TESTS`` (*default:* *none*) Set to ``true`` to test the REPRO build and confirm equivalence of DEBUG and From f21ec031ecb5a78caaae5a6d153feba8abf5d907 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 May 2024 04:24:15 -0400 Subject: [PATCH 04/21] *Fix ALE_remap_scalar call with h_in_Z_units Corrected an argument to the call to ALE_remap_scalar() when h_in_Z_units is true in MOM_initialize_tracer_from_Z(), to avoid the problems documented in github.com/NOAA-GFDL/MOM6/issues/589. A comment was also added explaining the logic of what is going on in this fork of the code. This commit will change answers with some generic tracers that are initialized from a Z-space input file, restoring them to previous values that worked previously (before about Feb. 1, 2024 on dev/gfdl) in Boussinesq configurations without dimensional consistency testing, but in a new form that does pass the dimensional consistency testing for depths and thicknesses. All answers are bitwise identical in any cases that do not use generic tracers. --- src/initialization/MOM_tracer_initialization_from_Z.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index d28a925c03..cac8a5cd6c 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -200,8 +200,10 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, US, PF, src_file, src_var_ enddo ; enddo if (h_is_in_Z_units) then + ! Because h is in units of [Z ~> m], dzSrc is already in the right units, but we need to + ! specify negligible thickness values with the right units. dz_neglect = set_dz_neglect(GV, US, remap_answer_date, dz_neglect_edge) - call ALE_remap_scalar(remapCS, G, GV, kd, hSrc, tr_z, h, tr, all_cells=.false., answer_date=remap_answer_date, & + call ALE_remap_scalar(remapCS, G, GV, kd, dzSrc, tr_z, h, tr, all_cells=.false., answer_date=remap_answer_date, & H_neglect=dz_neglect, H_neglect_edge=dz_neglect_edge) else ! Equation of state data is not available, so a simpler rescaling will have to suffice, From 705a38493fef60cd4d577315fe1d0ff9609a7d58 Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Mon, 1 Apr 2024 13:27:35 -0400 Subject: [PATCH 05/21] Add diag send complete calls to MOM --- config_src/infra/FMS1/MOM_diag_manager_infra.F90 | 6 ++++++ config_src/infra/FMS2/MOM_diag_manager_infra.F90 | 12 +++++++++++- src/framework/MOM_diag_mediator.F90 | 2 ++ 3 files changed, 19 insertions(+), 1 deletion(-) diff --git a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 index 18ccdaae67..cd9544d6e6 100644 --- a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 @@ -57,6 +57,7 @@ module MOM_diag_manager_infra public MOM_diag_manager_init public MOM_diag_manager_end public send_data_infra +public diag_send_complete_infra public MOM_diag_field_add_attribute public register_diag_field_infra public register_static_field_infra @@ -451,4 +452,9 @@ subroutine MOM_diag_field_add_attribute_i1d(diag_field_id, att_name, att_value) end subroutine MOM_diag_field_add_attribute_i1d +!> Finishes the diag manager reduction methods as needed for the time_step +!! Needed for backwards compatibility, does nothing +subroutine diag_send_complete_infra () +end subroutine diag_send_complete_infra + end module MOM_diag_manager_infra diff --git a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 index 18ccdaae67..230ee79566 100644 --- a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 @@ -14,13 +14,14 @@ module MOM_diag_manager_infra use diag_data_mod, only : null_axis_id use diag_manager_mod, only : fms_diag_manager_init => diag_manager_init use diag_manager_mod, only : fms_diag_manager_end => diag_manager_end +use diag_manager_mod, only : diag_send_complete use diag_manager_mod, only : send_data_fms => send_data use diag_manager_mod, only : fms_diag_field_add_attribute => diag_field_add_attribute use diag_manager_mod, only : DIAG_FIELD_NOT_FOUND use diag_manager_mod, only : register_diag_field_fms => register_diag_field use diag_manager_mod, only : register_static_field_fms => register_static_field use diag_manager_mod, only : get_diag_field_id_fms => get_diag_field_id -use MOM_time_manager, only : time_type +use MOM_time_manager, only : time_type, set_time use MOM_domain_infra, only : MOM_domain_type use MOM_error_infra, only : MOM_error => MOM_err, FATAL, WARNING @@ -57,6 +58,7 @@ module MOM_diag_manager_infra public MOM_diag_manager_init public MOM_diag_manager_end public send_data_infra +public diag_send_complete_infra public MOM_diag_field_add_attribute public register_diag_field_infra public register_static_field_infra @@ -451,4 +453,12 @@ subroutine MOM_diag_field_add_attribute_i1d(diag_field_id, att_name, att_value) end subroutine MOM_diag_field_add_attribute_i1d +!> Finishes the diag manager reduction methods as needed for the time_step +subroutine diag_send_complete_infra () + !! The time_step in the diag_send_complete call is a dummy argument, needed for backwards compatibility + !! It won't be used at all when diag_manager_nml::use_modern_diag=.true. + !! It won't have any impact when diag_manager_nml::use_modern_diag=.false. + call diag_send_complete (set_time(0)) +end subroutine diag_send_complete_infra + end module MOM_diag_manager_infra diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 5289d266df..b3194af3d8 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -14,6 +14,7 @@ module MOM_diag_mediator use MOM_diag_manager_infra, only : send_data_infra, MOM_diag_field_add_attribute, EAST, NORTH use MOM_diag_manager_infra, only : register_diag_field_infra, register_static_field_infra use MOM_diag_manager_infra, only : get_MOM_diag_field_id, DIAG_FIELD_NOT_FOUND +use MOM_diag_manager_infra, only : diag_send_complete_infra use MOM_diag_remap, only : diag_remap_ctrl, diag_remap_update, diag_remap_calc_hmask use MOM_diag_remap, only : diag_remap_init, diag_remap_end, diag_remap_do_remap use MOM_diag_remap, only : vertically_reintegrate_diag_field, vertically_interpolate_diag_field @@ -2078,6 +2079,7 @@ end subroutine enable_averages subroutine disable_averaging(diag_cs) type(diag_ctrl), intent(inout) :: diag_CS !< Structure used to regulate diagnostic output + call diag_send_complete_infra() diag_cs%time_int = 0.0 diag_cs%ave_enabled = .false. From 7305528fd99bc09bda648693cd7130e4627de25c Mon Sep 17 00:00:00 2001 From: Uriel Ramirez Date: Tue, 14 May 2024 16:43:16 -0400 Subject: [PATCH 06/21] Add diag_manager_set_time_end calls to the solo drivers --- config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 | 3 +++ config_src/drivers/solo_driver/MOM_driver.F90 | 3 +++ config_src/infra/FMS1/MOM_diag_manager_infra.F90 | 9 +++++++-- config_src/infra/FMS2/MOM_diag_manager_infra.F90 | 9 +++++++++ 4 files changed, 22 insertions(+), 2 deletions(-) diff --git a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 index c4be8c769d..787fa7e7d1 100644 --- a/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/drivers/ice_solo_driver/ice_shelf_driver.F90 @@ -26,6 +26,7 @@ program Shelf_main use MOM_debugging, only : MOM_debugging_init use MOM_diag_mediator, only : diag_mediator_init, diag_mediator_infrastructure_init, set_axes_info use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration + use MOM_diag_manager_infra, only : diag_manager_set_time_end_infra use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_domains, only : MOM_domains_init, clone_MOM_domain, pass_var use MOM_dyn_horgrid, only : dyn_horgrid_type, create_dyn_horgrid, destroy_dyn_horgrid @@ -325,6 +326,8 @@ program Shelf_main Time_end = daymax endif + call diag_manager_set_time_end_infra (Time_end) + if (Time >= Time_end) call MOM_error(FATAL, & "Shelf_driver: The run has been started at or after the end time of the run.") diff --git a/config_src/drivers/solo_driver/MOM_driver.F90 b/config_src/drivers/solo_driver/MOM_driver.F90 index 0e355f8638..9b85fafb8d 100644 --- a/config_src/drivers/solo_driver/MOM_driver.F90 +++ b/config_src/drivers/solo_driver/MOM_driver.F90 @@ -28,6 +28,7 @@ program MOM6 use MOM_cpu_clock, only : CLOCK_COMPONENT use MOM_data_override, only : data_override_init use MOM_diag_mediator, only : diag_mediator_end, diag_ctrl, diag_mediator_close_registration + use MOM_diag_manager_infra, only : diag_manager_set_time_end_infra use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, finish_MOM_initialization use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized @@ -375,6 +376,8 @@ program MOM6 Time_end = daymax endif + call diag_manager_set_time_end_infra(Time_end) + call get_param(param_file, mod_name, "SINGLE_STEPPING_CALL", single_step_call, & "If true, advance the state of MOM with a single step "//& "including both dynamics and thermodynamics. If false "//& diff --git a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 index cd9544d6e6..232986f480 100644 --- a/config_src/infra/FMS1/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS1/MOM_diag_manager_infra.F90 @@ -58,6 +58,7 @@ module MOM_diag_manager_infra public MOM_diag_manager_end public send_data_infra public diag_send_complete_infra +public diag_manager_set_time_end_infra public MOM_diag_field_add_attribute public register_diag_field_infra public register_static_field_infra @@ -452,9 +453,13 @@ subroutine MOM_diag_field_add_attribute_i1d(diag_field_id, att_name, att_value) end subroutine MOM_diag_field_add_attribute_i1d -!> Finishes the diag manager reduction methods as needed for the time_step -!! Needed for backwards compatibility, does nothing +!> Needed for backwards compatibility, does nothing subroutine diag_send_complete_infra () end subroutine diag_send_complete_infra +!> Needed for backwards compatibility, does nothing +subroutine diag_manager_set_time_end_infra(time) + type(time_type), intent(in) :: time !< The model time that simulation ends +end subroutine diag_manager_set_time_end_infra + end module MOM_diag_manager_infra diff --git a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 index 230ee79566..f05baa4474 100644 --- a/config_src/infra/FMS2/MOM_diag_manager_infra.F90 +++ b/config_src/infra/FMS2/MOM_diag_manager_infra.F90 @@ -15,6 +15,7 @@ module MOM_diag_manager_infra use diag_manager_mod, only : fms_diag_manager_init => diag_manager_init use diag_manager_mod, only : fms_diag_manager_end => diag_manager_end use diag_manager_mod, only : diag_send_complete +use diag_manager_mod, only : diag_manager_set_time_end use diag_manager_mod, only : send_data_fms => send_data use diag_manager_mod, only : fms_diag_field_add_attribute => diag_field_add_attribute use diag_manager_mod, only : DIAG_FIELD_NOT_FOUND @@ -59,6 +60,7 @@ module MOM_diag_manager_infra public MOM_diag_manager_end public send_data_infra public diag_send_complete_infra +public diag_manager_set_time_end_infra public MOM_diag_field_add_attribute public register_diag_field_infra public register_static_field_infra @@ -461,4 +463,11 @@ subroutine diag_send_complete_infra () call diag_send_complete (set_time(0)) end subroutine diag_send_complete_infra +!> Sets the time that the simulation ends in the diag manager +subroutine diag_manager_set_time_end_infra(time) + type(time_type), optional, intent(in) :: time !< The time the simulation ends + + call diag_manager_set_time_end(time) +end subroutine diag_manager_set_time_end_infra + end module MOM_diag_manager_infra From d90ff6b09acf421695d73d4c9206c07152b2a5d9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 19 Apr 2024 15:46:33 -0400 Subject: [PATCH 07/21] (*)Refactor and document soliton_initialization Refactored the code in soliton_initialization.F90 to more accurately reflect the nondimensionalization that was applied in developing this test case. This change includes reading in the maximum depth and beta, and using them to calculate the equatorial deformation radius and the external gravity wave speed. The references to the papers describing the test case in the module were added to the doxygen comments describing the routines in this module. This commit also includes adding comments documenting the nature and units of all the internal variables in this module. There are two new arguments each (param_file and just_read) to soliton_initialize_thickness and soliton_initialize_velocity to accommodate these changes, bringing them into line with the interfaces for other similar user initialization routines, and MOM_initialize_state was changed accordingly. This change could change answers in general, but in the specific examples that use this code, both beta and the external wave speed are deliberately set to 1 in MKS units, so this commit does not change answers for that specific case. --- .../MOM_state_initialization.F90 | 5 +- src/user/soliton_initialization.F90 | 108 +++++++++++++++--- 2 files changed, 94 insertions(+), 19 deletions(-) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 4f11233c93..c18752c83d 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -343,7 +343,8 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & just_read=just_read) case ("dumbbell"); call dumbbell_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) - case ("soliton"); call soliton_initialize_thickness(dz, depth_tot, G, GV, US) + case ("soliton"); call soliton_initialize_thickness(dz, depth_tot, G, GV, US, PF, & + just_read=just_read) case ("phillips"); call Phillips_initialize_thickness(dz, depth_tot, G, GV, US, PF, & just_read=just_read) case ("rossby_front") @@ -508,7 +509,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, US, PF, dirs, & case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, US, PF, just_read) case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & G, GV, US, PF, just_read) - case ("soliton"); call soliton_initialize_velocity(u, v, G, GV, US) + case ("soliton"); call soliton_initialize_velocity(u, v, G, GV, US, PF, just_read) case ("USER"); call user_initialize_velocity(u, v, G, GV, US, PF, just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& "Unrecognized velocity configuration "//trim(config)) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 06a781ec94..722a41b7e5 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -26,8 +26,9 @@ module soliton_initialization contains -!> Initialization of thicknesses in Equatorial Rossby soliton test -subroutine soliton_initialize_thickness(h, depth_tot, G, GV, US) +!> Initialization of thicknesses in equatorial Rossby soliton test, as described in section +!! 6.1 of Haidvogel and Beckman (1990) and in Boyd (1980, JPO) and Boyd (1985, JPO). +subroutine soliton_initialize_thickness(h, depth_tot, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -35,45 +36,96 @@ subroutine soliton_initialize_thickness(h, depth_tot, G, GV, US) intent(out) :: h !< The thickness that is being initialized [Z ~> m] real, dimension(SZI_(G),SZJ_(G)), & intent(in) :: depth_tot !< The nominal total depth of the ocean [Z ~> m] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. + ! Local variables + real :: max_depth ! Maximum depth of the model bathymetry [Z ~> m] + real :: cg_max ! The external wave speed based on max_depth [L T-1 ~> m s-1] + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] + real :: L_eq ! The equatorial deformation radius used in nondimensionalizing this problem [L ~> m] + real :: scale_pos ! A conversion factor to nondimensionalize the axis units, usually [m-1] + real :: x0 ! Initial x-position of the soliton in the same units as geoLonT, often [m]. + real :: y0 ! Initial y-position of the soliton in the same units as geoLatT, often [m]. + real :: x, y ! Nondimensionalized positions [nondim] + real :: I_nz ! The inverse of the number of layers [nondim] + real :: val1 ! A nondimensionlized zonal decay scale [nondim] + real :: val2 ! An overall surface height anomaly amplitude [L T-1 ~> m s-1] + real :: val3 ! A decay factor [nondim] + real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz - real :: x, y, x0, y0 - real :: val1, val2, val3, val4 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - call MOM_mesg("soliton_initialization.F90, soliton_initialize_thickness: setting thickness") + if (.not.just_read) & + call MOM_mesg("soliton_initialization.F90, soliton_initialize_thickness: setting thickness") + + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, & + units="m", default=-1.e9, scale=US%m_to_Z, do_not_log=.true.) + call get_param(param_file, mdl, "BETA", beta, & + "The northward gradient of the Coriolis parameter with the betaplane option.", & + units="m-1 s-1", default=0.0, scale=US%T_to_s*US%L_to_m, do_not_log=.true.) + + if (just_read) return ! All run-time parameters have been read, so return. + + if (max_depth <= 0.0) call MOM_error(FATAL, & + "soliton_initialization, soliton_initialize_thickness: "//& + "This module requires a positive value of MAXIMUM_DEPTH.") + if (abs(beta) <= 0.0) call MOM_error(FATAL, & + "soliton_initialization, soliton_initialize_thickness: "//& + "This module requires a non-zero value of BETA.") + + cg_max = sqrt(GV%g_Earth * max_depth) + L_eq = sqrt(cg_max / abs(beta)) + scale_pos = US%m_to_L / L_eq + I_nz = 1.0 / real(nz) x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = US%m_to_Z * 0.771*(val1*val1) + val2 = max_depth * 0.771*(val1*val1) do j = G%jsc,G%jec ; do i = G%isc,G%iec do k = 1, nz - x = G%geoLonT(i,j)-x0 - y = G%geoLatT(i,j)-y0 + x = (G%geoLonT(i,j)-x0) * scale_pos + y = (G%geoLatT(i,j)-y0) * scale_pos val3 = exp(-val1*x) val4 = val2 * ( 2.0*val3 / (1.0 + (val3*val3)) )**2 - h(i,j,k) = (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + depth_tot(i,j)) + h(i,j,k) = (0.25*val4*(6.0*y*y + 3.0) * exp(-0.5*y*y) + depth_tot(i,j)) * I_nz enddo enddo ; enddo end subroutine soliton_initialize_thickness -!> Initialization of u and v in the equatorial Rossby soliton test -subroutine soliton_initialize_velocity(u, v, G, GV, US) +!> Initialization of u and v in the equatorial Rossby soliton test, as described in section +!! 6.1 of Haidvogel and Beckman (1990) and in Boyd (1980, JPO) and Boyd (1985, JPO). +subroutine soliton_initialize_velocity(u, v, G, GV, US, param_file, just_read) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(out) :: u !< i-component of velocity [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(out) :: v !< j-component of velocity [L T-1 ~> m s-1] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: just_read !< If true, this call will only read + !! parameters without changing h. ! Local variables - real :: x, x0 ! Positions in the same units as geoLonT. - real :: y, y0 ! Positions in the same units as geoLatT. - real :: val1 ! A zonal decay scale in the inverse of the units of geoLonT. + real :: max_depth ! Maximum depth of the model bathymetry [Z ~> m] + real :: cg_max ! The external wave speed based on max_depth [L T-1 ~> m s-1] + real :: beta ! The meridional gradient of the Coriolis parameter [T-1 L-1 ~> s-1 m-1] + real :: L_eq ! The equatorial deformation radius used in nondimensionalizing this problem [L ~> m] + real :: scale_pos ! A conversion factor to nondimensionalize the axis units, usually [m-1] + real :: x0 ! Initial x-position of the soliton in the same units as geoLonT, often [m]. + real :: y0 ! Initial y-position of the soliton in the same units as geoLatT, often [m]. + real :: x, y ! Nondimensionalized positions [nondim] + real :: val1 ! A nondimensionlized zonal decay scale [nondim] real :: val2 ! An overall velocity amplitude [L T-1 ~> m s-1] real :: val3 ! A decay factor [nondim] real :: val4 ! The local velocity amplitude [L T-1 ~> m s-1] @@ -81,18 +133,40 @@ subroutine soliton_initialize_velocity(u, v, G, GV, US) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + if (.not.just_read) & + call MOM_mesg("soliton_initialization.F90, soliton_initialize_thickness: setting thickness") + + call get_param(param_file, mdl, "MAXIMUM_DEPTH", max_depth, & + units="m", default=-1.e9, scale=US%m_to_Z, do_not_log=.true.) + call get_param(param_file, mdl, "BETA", beta, & + "The northward gradient of the Coriolis parameter with the betaplane option.", & + units="m-1 s-1", default=0.0, scale=US%T_to_s*US%L_to_m, do_not_log=.true.) + + if (just_read) return ! All run-time parameters have been read, so return. + + if (max_depth <= 0.0) call MOM_error(FATAL, & + "soliton_initialization, soliton_initialize_velocity: "//& + "This module requires a positive value of MAXIMUM_DEPTH.") + if (abs(beta) <= 0.0) call MOM_error(FATAL, & + "soliton_initialization, soliton_initialize_velocity: "//& + "This module requires a non-zero value of BETA.") + + cg_max = sqrt(GV%g_Earth * max_depth) + L_eq = sqrt(cg_max / abs(beta)) + scale_pos = US%m_to_L / L_eq + x0 = 2.0*G%len_lon/3.0 y0 = 0.0 val1 = 0.395 - val2 = US%m_s_to_L_T * 0.771*(val1*val1) + val2 = cg_max * 0.771*(val1*val1) v(:,:,:) = 0.0 u(:,:,:) = 0.0 do j = G%jsc,G%jec ; do I = G%isc-1,G%iec+1 do k = 1, nz - x = 0.5*(G%geoLonT(i+1,j)+G%geoLonT(i,j))-x0 - y = 0.5*(G%geoLatT(i+1,j)+G%geoLatT(i,j))-y0 + x = (0.5*(G%geoLonT(i+1,j)+G%geoLonT(i,j))-x0) * scale_pos + y = (0.5*(G%geoLatT(i+1,j)+G%geoLatT(i,j))-y0) * scale_pos val3 = exp(-val1*x) val4 = val2*((2.0*val3/(1.0+(val3*val3)))**2) u(I,j,k) = 0.25*val4*(6.0*y*y-9.0) * exp(-0.5*y*y) From 3c87d981dc4a895fa7528a1b805078085370c27a Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 May 2024 03:53:38 -0400 Subject: [PATCH 08/21] (*)Correct rescaling of KPP pseudo-salt flux Calculate the rescaled pseudo-salt flux when KPP is in use inside of pseudo_salt_tracer_column_physics(), rather than using fluxes%KPP_salt_flux. This commit also corrects for the fact that salinity and pseudo-salt have scaling that differs by a factor of US%S_to_ppt, which was not previously being taken into account. All answers are bitwise identical when no dimensional rescaling is being used, but they will change (and be corrected) when salinity is being rescaled. --- src/tracer/pseudo_salt_tracer.F90 | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index 1185f70d22..ade36bad19 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -196,6 +196,8 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G ! h_new(k) = h_old(k) + ea(k) - eb(k-1) + eb(k) - ea(k+1) ! Local variables + real :: net_salt_rate(SZI_(G),SZJ_(G)) ! Net salt flux into the ocean + ! [ppt H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real :: net_salt(SZI_(G),SZJ_(G)) ! Net salt flux into the ocean integrated over ! a timestep [ppt H ~> ppt m or ppt kg m-2] real :: htot(SZI_(G)) ! Total ocean depth [H ~> m or kg m-2] @@ -216,11 +218,27 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G call hchksum(CS%ps,"pseudo_salt pre pseudo-salt vertdiff", G%HI) endif + FluxRescaleDepth = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth + ! Compute KPP nonlocal term if necessary if (present(KPP_CSp)) then - if (associated(KPP_CSp) .and. present(nonLocalTrans)) & - call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, fluxes%KPP_salt_flux(:,:), & + if (associated(KPP_CSp) .and. present(nonLocalTrans)) then + ! Determine the salt flux, including limiting for small total ocean depths. + net_salt_rate(:,:) = 0.0 + if (associated(fluxes%salt_flux)) then + do j=js,je + do i=is,ie ; htot(i) = h_old(i,j,1) ; enddo + do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h_old(i,j,k) ; enddo ; enddo + do i=is,ie + scale = 1.0 ; if ((Ih_limit > 0.0) .and. (htot(i)*Ih_limit < 1.0)) scale = htot(i)*Ih_limit + net_salt_rate(i,j) = (scale * (1000.0 * fluxes%salt_flux(i,j))) * GV%RZ_to_H + enddo + enddo + endif + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, net_salt_rate, & dt, CS%diag, CS%tr_ptr, CS%ps(:,:,:)) + endif endif ! This uses applyTracerBoundaryFluxesInOut, usually in ALE mode @@ -229,8 +247,6 @@ subroutine pseudo_salt_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G ! Determine the time-integrated salt flux, including limiting for small total ocean depths. net_Salt(:,:) = 0.0 - FluxRescaleDepth = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) - Ih_limit = 0.0 ; if (FluxRescaleDepth > 0.0) Ih_limit = 1.0 / FluxRescaleDepth do j=js,je do i=is,ie ; htot(i) = h_old(i,j,1) ; enddo do k=2,nz ; do i=is,ie ; htot(i) = htot(i) + h_old(i,j,k) ; enddo ; enddo From 506d1864ca51452cce32b85a326d0f7fd8949677 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Sat, 11 May 2024 03:54:21 -0400 Subject: [PATCH 09/21] +Eliminate fluxes%KPP_salt_flux Eliminated the KPP_salt_flux element of the forcing type, which is no longer being used after the revisions to pseudo_salt_tracer_column_physics. Also moved 5 allocatable arrays (KPP_NLTheat, KPP_NLTscalar, KPP_buoy_flux, KPP_temp_flux and KPP_salt_flux) out of diabatic_CS, replacing them with ordinary arrays in diabatic_ALE(), diabatic_ALE_legacy() and layered_diabatic(). This change could reduce the high-water memory footprint of the model when KPP is in use. All answers are bitwise identical, but one element of a publicly visible type has been eliminated. --- src/core/MOM_forcing_type.F90 | 3 +- .../vertical/MOM_diabatic_driver.F90 | 149 ++++++++---------- 2 files changed, 70 insertions(+), 82 deletions(-) diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 452161c6ca..72c67253ed 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -126,9 +126,8 @@ module MOM_forcing_type real, pointer, dimension(:,:) :: & netMassIn => NULL(), & !< Sum of water mass fluxes into the ocean integrated over a !! forcing timestep [H ~> m or kg m-2] - netMassOut => NULL(), & !< Net water mass flux out of the ocean integrated over a forcing timestep, + netMassOut => NULL() !< Net water mass flux out of the ocean integrated over a forcing timestep, !! with negative values for water leaving the ocean [H ~> m or kg m-2] - KPP_salt_flux => NULL() !< KPP effective salt flux [ppt m s-1] ! heat associated with water crossing ocean surface real, pointer, dimension(:,:) :: & diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 081f065f3e..010f17b978 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -244,15 +244,6 @@ module MOM_diabatic_driver type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass type(group_pass_type) :: pass_Kv !< For group halo pass type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm - ! Data arrays for communicating between components - !### Why are these arrays in this control structure, and not local variables in the various routines? - real, allocatable, dimension(:,:,:) :: KPP_NLTheat !< KPP non-local transport for heat [nondim] - real, allocatable, dimension(:,:,:) :: KPP_NLTscalar !< KPP non-local transport for scalars [nondim] - real, allocatable, dimension(:,:,:) :: KPP_buoy_flux !< KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] - real, allocatable, dimension(:,:) :: KPP_temp_flux !< KPP effective temperature flux - !! [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] - real, allocatable, dimension(:,:) :: KPP_salt_flux !< KPP effective salt flux - !! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -558,11 +549,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_ePBL, & ! test array of diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + KPP_NLTheat, & ! KPP non-local transport for heat [nondim] + KPP_NLTscalar, & ! KPP non-local transport for scalars [nondim] + KPP_buoy_flux, & ! KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & U_star, & ! The friction velocity [Z T-1 ~> m s-1]. + KPP_temp_flux, & ! KPP effective temperature flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + KPP_salt_flux, & ! KPP effective salt flux [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL logical, dimension(SZI_(G)) :: & @@ -677,11 +673,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! KPP needs the surface buoyancy flux but does not update state variables. ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. - ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux - ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! Sets: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux + ! NOTE: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux are returned as rates (i.e. stuff per second) ! unlike other instances where the fluxes are integrated in time over a time-step. call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux) ! Determine the friction velocity, perhaps using the evovling surface density. call find_ustar(fluxes, tv, U_star, G, GV, US) @@ -689,16 +685,16 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! The KPP scheme calculates boundary layer diffusivities and non-local transport. if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves) + U_star, KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif if (associated(Hml)) then @@ -708,7 +704,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) endif @@ -733,18 +729,18 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + call hchksum(KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & scale=US%C_to_degC*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + call hchksum(KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + call hchksum(KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, KPP_NLTheat, KPP_temp_flux, & dt, tv%tr_T, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, KPP_NLTscalar, KPP_salt_flux, & dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") @@ -755,7 +751,6 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif - if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! This is the "old" method for applying differential diffusion. @@ -1084,7 +1079,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=CS%KPP_NLTscalar, & + nonLocalTrans=KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) @@ -1174,11 +1169,16 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int returned from set_diffusivity [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_ePBL, & ! boundary layer or convective diapycnal diffusivities at interfaces [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + KPP_NLTheat, & ! KPP non-local transport for heat [nondim] + KPP_NLTscalar, & ! KPP non-local transport for scalars [nondim] + KPP_buoy_flux, & ! KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] real, dimension(SZI_(G),SZJ_(G)) :: & U_star, & ! The friction velocity [Z T-1 ~> m s-1]. + KPP_temp_flux, & ! KPP effective temperature flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + KPP_salt_flux, & ! KPP effective salt flux [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] SkinBuoyFlux ! 2d surface buoyancy flux [Z2 T-3 ~> m2 s-3], used by ePBL logical, dimension(SZI_(G)) :: & @@ -1298,11 +1298,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! KPP needs the surface buoyancy flux but does not update state variables. ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. - ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux - ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! Sets: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux + ! NOTE: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux are returned as rates (i.e. stuff per second) ! unlike other instances where the fluxes are integrated in time over a time-step. call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux) ! Determine the friction velocity, perhaps using the evovling surface density. call find_ustar(fluxes, tv, U_star, G, GV, US) @@ -1310,16 +1310,16 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! The KPP scheme calculates boundary layer diffusivities and non-local transport. if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves) + U_star, KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif if (associated(Hml)) then @@ -1329,7 +1329,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) endif @@ -1340,18 +1340,18 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_thermovar_chksum("after KPP", tv, G, US) call hchksum(Kd_heat, "after KPP Kd_heat", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) call hchksum(Kd_salt, "after KPP Kd_salt", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + call hchksum(KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & scale=US%C_to_degC*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + call hchksum(KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + call hchksum(KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, KPP_NLTheat, KPP_temp_flux, & dt, tv%tr_T, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, KPP_NLTscalar, KPP_salt_flux, & dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") @@ -1362,7 +1362,6 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call MOM_forcing_chksum("after KPP_applyNLT ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after KPP_applyNLT ", tv, G, US) endif - if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Calculate vertical mixing due to convection (computed via CVMix) @@ -1607,7 +1606,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=CS%KPP_NLTscalar, & + nonLocalTrans=KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & minimum_forcing_depth=CS%minimum_forcing_depth) @@ -1693,6 +1692,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G)) :: & U_star, & ! The friction velocity [Z T-1 ~> m s-1]. + KPP_temp_flux, & ! KPP effective temperature flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] + KPP_salt_flux, & ! KPP effective salt flux [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] Rcv_ml ! Coordinate density of mixed layer [R ~> kg m-3], used for applying sponges real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), target :: & @@ -1710,6 +1711,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] Kd_extra_S , & ! The extra diffusivity of salinity due to double diffusion relative to ! Kd_int [H Z T-1 ~> m2 s-1 or kg m-1 s-1] + KPP_NLTheat, & ! KPP non-local transport for heat [nondim] + KPP_NLTscalar, & ! KPP non-local transport for scalars [nondim] + KPP_buoy_flux, & ! KPP forcing buoyancy flux [L2 T-3 ~> m2 s-3] Tdif_flx, & ! diffusive diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Tadv_flx, & ! advective diapycnal heat flux across interfaces [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] Sdif_flx, & ! diffusive diapycnal salt flux across interfaces [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] @@ -1902,11 +1906,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call cpu_clock_begin(id_clock_kpp) ! KPP needs the surface buoyancy flux but does not update state variables. ! We could make this call higher up to avoid a repeat unpacking of the surface fluxes. - ! Sets: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux - ! NOTE: CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux are returned as rates (i.e. stuff per second) + ! Sets: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux + ! NOTE: KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux are returned as rates (i.e. stuff per second) ! unlike other instances where the fluxes are integrated in time over a time-step. call calculateBuoyancyFlux2d(G, GV, US, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + KPP_buoy_flux, KPP_temp_flux, KPP_salt_flux) ! The KPP scheme calculates boundary layer diffusivities and non-local transport. ! Set diffusivities for heat and salt separately @@ -1931,16 +1935,16 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if ( associated(fluxes%lamult) ) then call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) + U_star, KPP_buoy_flux, Waves=Waves, lamult=fluxes%lamult) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves, lamult=fluxes%lamult) else call KPP_compute_BLD(CS%KPP_CSp, G, GV, US, h, tv%T, tv%S, u, v, tv, & - U_star, CS%KPP_buoy_flux, Waves=Waves) + U_star, KPP_buoy_flux, Waves=Waves) - call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, CS%KPP_buoy_flux, Kd_heat, & - Kd_salt, visc%Kv_shear, CS%KPP_NLTheat, CS%KPP_NLTscalar, Waves=Waves) + call KPP_calculate(CS%KPP_CSp, G, GV, US, h, tv, U_star, KPP_buoy_flux, Kd_heat, & + Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif if (associated(Hml)) then @@ -1950,7 +1954,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) endif if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = CS%KPP_buoy_flux(:,:,1) + visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) endif @@ -1977,7 +1981,6 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call hchksum(Kd_lay, "after KPP Kd_lay", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) call hchksum(Kd_Int, "after KPP Kd_Int", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif - if (.not.associated(fluxes%KPP_salt_flux)) fluxes%KPP_salt_flux => CS%KPP_salt_flux endif ! endif for KPP ! Add vertical diff./visc. due to convection (computed via CVMix) @@ -1988,18 +1991,18 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%useKPP) then call cpu_clock_begin(id_clock_kpp) if (CS%debug) then - call hchksum(CS%KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & + call hchksum(KPP_temp_flux, "before KPP_applyNLT netHeat", G%HI, haloshift=0, & scale=US%C_to_degC*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & + call hchksum(KPP_salt_flux, "before KPP_applyNLT netSalt", G%HI, haloshift=0, & scale=US%S_to_ppt*GV%H_to_m*US%s_to_T) - call hchksum(CS%KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) - call hchksum(CS%KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) + call hchksum(KPP_NLTheat, "before KPP_applyNLT NLTheat", G%HI, haloshift=0) + call hchksum(KPP_NLTscalar, "before KPP_applyNLT NLTscalar", G%HI, haloshift=0) endif ! Apply non-local transport of heat and salt ! Changes: tv%T, tv%S - call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, CS%KPP_NLTheat, CS%KPP_temp_flux, & + call KPP_NonLocalTransport_temp(CS%KPP_CSp, G, GV, h, KPP_NLTheat, KPP_temp_flux, & dt, tv%tr_T, tv%T, tv%C_p) - call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, CS%KPP_NLTscalar, CS%KPP_salt_flux, & + call KPP_NonLocalTransport_saln(CS%KPP_CSp, G, GV, h, KPP_NLTscalar, KPP_salt_flux, & dt, tv%tr_S, tv%S) call cpu_clock_end(id_clock_kpp) if (showCallTree) call callTree_waypoint("done with KPP_applyNonLocalTransport (diabatic)") @@ -2401,7 +2404,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=CS%KPP_NLTscalar) + nonLocalTrans=KPP_NLTscalar) elseif (CS%double_diffuse) then ! extra diffusivity for passive tracers @@ -2423,13 +2426,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=CS%KPP_NLTscalar) + nonLocalTrans=KPP_NLTscalar) else call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=CS%KPP_NLTscalar) + nonLocalTrans=KPP_NLTscalar) endif ! (CS%mix_boundary_tracers) @@ -3315,14 +3318,6 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive CS%useKPP = KPP_init(param_file, G, GV, US, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) - if (CS%useKPP) then - allocate(CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1), source=0.0) - allocate(CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1), source=0.0) - allocate(CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1), source=0.0) - allocate(CS%KPP_temp_flux(isd:ied,jsd:jed), source=0.0) - allocate(CS%KPP_salt_flux(isd:ied,jsd:jed), source=0.0) - endif - ! Diagnostics for tendencies of temperature and salinity due to diabatic processes, ! available only for ALE algorithm. @@ -3616,14 +3611,8 @@ subroutine diabatic_driver_end(CS) if (CS%use_geothermal) & call geothermal_end(CS%geothermal) - if (CS%useKPP) then - deallocate( CS%KPP_buoy_flux ) - deallocate( CS%KPP_temp_flux ) - deallocate( CS%KPP_salt_flux ) - deallocate( CS%KPP_NLTheat ) - deallocate( CS%KPP_NLTscalar ) + if (CS%useKPP) & call KPP_end(CS%KPP_CSp) - endif ! GMM, the following is commented out because arrays in ! CS%diag_grids_prev are neither pointers or allocatables From c121215cbfbfc0944418abb4ea3490649f97c946 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 24 May 2024 05:23:22 -0400 Subject: [PATCH 10/21] Fix TEOS10 argument descriptions Corrected the descriptions of several conservative temperature and absolute salinity arguments in the comments for arguments to 4 TEOS10 equation of state routines, and eliminated the commented out code to mask out negative salinities in 8 TEOS10 routines. Only comments are changed, and all answers are bitwise identical. --- src/equation_of_state/MOM_EOS_TEOS10.F90 | 139 +++++++++-------------- 1 file changed, 53 insertions(+), 86 deletions(-) diff --git a/src/equation_of_state/MOM_EOS_TEOS10.F90 b/src/equation_of_state/MOM_EOS_TEOS10.F90 index 3f138e20bb..6e4aaa762f 100644 --- a/src/equation_of_state/MOM_EOS_TEOS10.F90 +++ b/src/equation_of_state/MOM_EOS_TEOS10.F90 @@ -50,13 +50,6 @@ real elemental function density_elem_TEOS10(this, T, S, pressure) real, intent(in) :: S !< Absolute salinity [g kg-1]. real, intent(in) :: pressure !< pressure [Pa]. - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA -! if (S < -1.0e-10) then ! Can we assume safely that this is a missing value? -! density_elem_TEOS10 = 1000.0 -! else -! density_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) -! endif - density_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) end function density_elem_TEOS10 @@ -69,13 +62,6 @@ real elemental function density_anomaly_elem_TEOS10(this, T, S, pressure, rho_re real, intent(in) :: pressure !< pressure [Pa]. real, intent(in) :: rho_ref !< A reference density [kg m-3]. - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA -! if (S < -1.0e-10) then ! Can we assume safely that this is a missing value? -! density_elem_TEOS10 = 1000.0 -! else -! density_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) -! endif - density_anomaly_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) density_anomaly_elem_TEOS10 = density_anomaly_elem_TEOS10 - rho_ref @@ -88,13 +74,6 @@ real elemental function spec_vol_elem_TEOS10(this, T, S, pressure) real, intent(in) :: S !< Absolute salinity [g kg-1]. real, intent(in) :: pressure !< pressure [Pa]. - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA -! if (S < -1.0e-10) then ! Can we assume safely that this is a missing value? -! spec_vol_elem_TEOS10 = 0.001 -! else -! spec_vol_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) -! endif - spec_vol_elem_TEOS10 = gsw_specvol(S, T, pressure * Pa2db) end function spec_vol_elem_TEOS10 @@ -107,13 +86,6 @@ real elemental function spec_vol_anomaly_elem_TEOS10(this, T, S, pressure, spv_r real, intent(in) :: pressure !< pressure [Pa]. real, intent(in) :: spv_ref !< A reference specific volume [m3 kg-1]. - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA -! if (S < -1.0e-10) then ! Can we assume safely that this is a missing value? -! spec_vol_elem_TEOS10 = 0.001 -! else -! spec_vol_elem_TEOS10 = gsw_rho(S, T, pressure * Pa2db) -! endif - spec_vol_anomaly_elem_TEOS10 = gsw_specvol(S, T, pressure * Pa2db) - spv_ref end function spec_vol_anomaly_elem_TEOS10 @@ -122,28 +94,27 @@ end function spec_vol_anomaly_elem_TEOS10 !! temperature and absolute salinity, using the TEOS10 expressions. elemental subroutine calculate_density_derivs_elem_TEOS10(this, T, S, pressure, drho_dT, drho_dS) class(TEOS10_EOS), intent(in) :: this !< This EOS - real, intent(in) :: T !< Potential temperature relative to the surface [degC] - real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] = [ppt] real, intent(in) :: pressure !< Pressure [Pa] - real, intent(out) :: drho_dT !< The partial derivative of density with potential + real, intent(out) :: drho_dT !< The partial derivative of density with conservative !! temperature [kg m-3 degC-1] real, intent(out) :: drho_dS !< The partial derivative of density with salinity, - !! in [kg m-3 PSU-1] + !! in [kg m-3 ppt-1] ! Local variables real :: zs ! Absolute salinity [g kg-1] real :: zt ! Conservative temperature [degC] real :: zp ! Pressure converted to decibars [dbar] - !Conversions - zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp - zp = pressure* Pa2db !Convert pressure from Pascal to decibar - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA - !if (S < -1.0e-10) then !Can we assume safely that this is a missing value? - ! drho_dT = 0.0 ; drho_dS = 0.0 - !else - call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) - !endif + ! Conversions + zs = S + zt = T + zp = pressure * Pa2db ! Convert pressure from Pascal to decibar + ! The following conversions are unnecessary because the arguments are already the right variables. + ! zs = gsw_sr_from_sp(S) ! Uncomment to convert practical salinity to absolute salinity + ! zt = gsw_ct_from_pt(S,T) ! Uncomment to convert potential temp to conservative temp + + call gsw_rho_first_derivatives(zs, zt, zp, drho_dsa=drho_dS, drho_dct=drho_dT) end subroutine calculate_density_derivs_elem_TEOS10 @@ -151,17 +122,17 @@ end subroutine calculate_density_derivs_elem_TEOS10 elemental subroutine calculate_density_second_derivs_elem_TEOS10(this, T, S, pressure, & drho_dS_dS, drho_dS_dT, drho_dT_dT, drho_dS_dP, drho_dT_dP) class(TEOS10_EOS), intent(in) :: this !< This EOS - real, intent(in) :: T !< Potential temperature referenced to 0 dbar [degC] - real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] = [ppt] real, intent(in) :: pressure !< Pressure [Pa] real, intent(inout) :: drho_ds_ds !< Partial derivative of beta with respect - !! to S [kg m-3 PSU-2] + !! to S [kg m-3 ppt-2] real, intent(inout) :: drho_ds_dt !< Partial derivative of beta with respect - !! to T [kg m-3 PSU-1 degC-1] + !! to T [kg m-3 ppt-1 degC-1] real, intent(inout) :: drho_dt_dt !< Partial derivative of alpha with respect !! to T [kg m-3 degC-2] real, intent(inout) :: drho_ds_dp !< Partial derivative of beta with respect - !! to pressure [kg m-3 PSU-1 Pa-1] = [s2 m-2 PSU-1] + !! to pressure [kg m-3 ppt-1 Pa-1] = [s2 m-2 ppt-1] real, intent(inout) :: drho_dt_dp !< Partial derivative of alpha with respect !! to pressure [kg m-3 degC-1 Pa-1] = [s2 m-2 degC-1] ! Local variables @@ -169,18 +140,16 @@ elemental subroutine calculate_density_second_derivs_elem_TEOS10(this, T, S, pre real :: zt ! Conservative temperature [degC] real :: zp ! Pressure converted to decibars [dbar] - !Conversions - zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp - zp = pressure* Pa2db !Convert pressure from Pascal to decibar - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA - !if (S < -1.0e-10) then !Can we assume safely that this is a missing value? - ! drho_dS_dS = 0.0 ; drho_dS_dT = 0.0 ; drho_dT_dT = 0.0 - ! drho_dS_dP = 0.0 ; drho_dT_dP = 0.0 - !else - call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & - rho_ct_ct=drho_dT_dT, rho_sa_p=drho_dS_dP, rho_ct_p=drho_dT_dP) - !endif + ! Conversions + zs = S + zt = T + zp = pressure * Pa2db ! Convert pressure from Pascal to decibar + ! The following conversions are unnecessary because the arguments are already the right variables. + ! zs = gsw_sr_from_sp(S) ! Uncomment to convert practical salinity to absolute salinity + ! zt = gsw_ct_from_pt(S,T) ! Uncomment to convert potential temp to conservative temp + + call gsw_rho_second_derivatives(zs, zt, zp, rho_sa_sa=drho_dS_dS, rho_sa_ct=drho_dS_dT, & + rho_ct_ct=drho_dT_dT, rho_sa_p=drho_dS_dP, rho_ct_p=drho_dT_dP) end subroutine calculate_density_second_derivs_elem_TEOS10 @@ -188,28 +157,27 @@ end subroutine calculate_density_second_derivs_elem_TEOS10 !! temperature and absolute salinity, using the TEOS10 expressions. elemental subroutine calculate_specvol_derivs_elem_TEOS10(this, T, S, pressure, dSV_dT, dSV_dS) class(TEOS10_EOS), intent(in) :: this !< This EOS - real, intent(in) :: T !< Potential temperature [degC] - real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] = [ppt] real, intent(in) :: pressure !< Pressure [Pa] real, intent(inout) :: dSV_dT !< The partial derivative of specific volume with - !! potential temperature [m3 kg-1 degC-1] + !! conservative temperature [m3 kg-1 degC-1] real, intent(inout) :: dSV_dS !< The partial derivative of specific volume with - !! salinity [m3 kg-1 PSU-1] + !! absolute salinity [m3 kg-1 ppt-1] ! Local variables real :: zs ! Absolute salinity [g kg-1] real :: zt ! Conservative temperature [degC] real :: zp ! Pressure converted to decibars [dbar] - !Conversions - zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp - zp = pressure* Pa2db !Convert pressure from Pascal to decibar - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA - !if (S < -1.0e-10) then !Can we assume safely that this is a missing value? - ! dSV_dT = 0.0 ; dSV_dS = 0.0 - !else - call gsw_specvol_first_derivatives(zs,zt,zp, v_sa=dSV_dS, v_ct=dSV_dT) - !endif + ! Conversions + zs = S + zt = T + zp = pressure * Pa2db ! Convert pressure from Pascal to decibar + ! The following conversions are unnecessary because the arguments are already the right variables. + ! zs = gsw_sr_from_sp(S) ! Uncomment to convert practical salinity to absolute salinity + ! zt = gsw_ct_from_pt(S,T) ! Uncomment to convert potential temp to conservative temp + + call gsw_specvol_first_derivatives(zs, zt, zp, v_sa=dSV_dS, v_ct=dSV_dT) end subroutine calculate_specvol_derivs_elem_TEOS10 @@ -220,8 +188,8 @@ end subroutine calculate_specvol_derivs_elem_TEOS10 !! subroutines from TEOS10 website elemental subroutine calculate_compress_elem_TEOS10(this, T, S, pressure, rho, drho_dp) class(TEOS10_EOS), intent(in) :: this !< This EOS - real, intent(in) :: T !< Potential temperature relative to the surface [degC] - real, intent(in) :: S !< Salinity [PSU] + real, intent(in) :: T !< Conservative temperature [degC] + real, intent(in) :: S !< Absolute salinity [g kg-1] real, intent(in) :: pressure !< Pressure [Pa] real, intent(out) :: rho !< In situ density [kg m-3] real, intent(out) :: drho_dp !< The partial derivative of density with pressure @@ -233,17 +201,16 @@ elemental subroutine calculate_compress_elem_TEOS10(this, T, S, pressure, rho, d real :: zt ! Conservative temperature [degC] real :: zp ! Pressure converted to decibars [dbar] - !Conversions - zs = S !gsw_sr_from_sp(S) !Convert practical salinity to absolute salinity - zt = T !gsw_ct_from_pt(S,T) !Convert potential temp to conservative temp - zp = pressure* Pa2db !Convert pressure from Pascal to decibar - !!! #### This code originally had this "masking" line. The answer to the question below is "no" -AJA - !if (S < -1.0e-10) then !Can we assume safely that this is a missing value? - ! rho = 1000.0 ; drho_dp = 0.0 - !else - rho = gsw_rho(zs,zt,zp) - call gsw_rho_first_derivatives(zs,zt,zp, drho_dp=drho_dp) - !endif + ! Conversions + zs = S + zt = T + zp = pressure * Pa2db ! Convert pressure from Pascal to decibar + ! The following conversions are unnecessary because the arguments are already the right variables. + ! zs = gsw_sr_from_sp(S) ! Uncomment to convert practical salinity to absolute salinity + ! zt = gsw_ct_from_pt(S,T) ! Uncomment to convert potential temp to conservative temp + + rho = gsw_rho(zs, zt, zp) + call gsw_rho_first_derivatives(zs, zt, zp, drho_dp=drho_dp) end subroutine calculate_compress_elem_TEOS10 From 836e696c2e1fdf088150744e42a6aceb1536a184 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Apr 2024 06:46:00 -0400 Subject: [PATCH 11/21] +Add convert_MLD_to_ML_thickness Added the routine convert_MLD_to_ML_thickness to consistently convert the mixed layer depths (in units of [Z ~> m]) back to the mixed layer thicknesses (in [H ~> m or kg m-2]), with proper error checking and handling of the non-Boussinesq case. The body of this routine was taken from duplicated blocks of code in MOM_mixedlayer_restrat.F90. This is not tested directly in this PR, but it was tested via revisions to MOM_mixedlayer_restrat.F90 that are included in a subsequent commit. All answers are bitwise identical, but there is a new publicly visible interface. --- src/core/MOM_interface_heights.F90 | 66 ++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index 6681034cb9..3891c86e3a 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -19,6 +19,7 @@ module MOM_interface_heights public find_eta, dz_to_thickness, thickness_to_dz, dz_to_thickness_simple public calc_derived_thermo +public convert_MLD_to_ML_thickness public find_rho_bottom, find_col_avg_SpV !> Calculates the heights of the free surface or all interfaces from layer thicknesses. @@ -824,4 +825,69 @@ subroutine thickness_to_dz_jslice(h, tv, dz, j, G, GV, halo_size) end subroutine thickness_to_dz_jslice + +!> Convert mixed layer depths in height units into the thickness of water in the mixed +!! in thickness units. +subroutine convert_MLD_to_ML_thickness(MLD_in, h, h_MLD, tv, G, GV, halo) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: MLD_in !< Input mixed layer depth [Z ~> m]. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: h_MLD !< Thickness of water in the mixed layer [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< Structure containing pointers to any available + !! thermodynamic fields. + integer, optional, intent(in) :: halo !< Halo width over which to calculate frazil + + ! Local variables + real :: MLD_rem(SZI_(G)) ! The vertical extent of the MLD_in that has not yet been accounted for [Z ~> m] + character(len=128) :: mesg ! A string for error messages + logical :: keep_going + integer :: i, j, k, is, ie, js, je, nz, halos + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + halos = 0 ; if (present(halo)) halos = halo + if (present(halo)) then + is = G%isc-halo ; ie = G%iec+halo ; js = G%jsc-halo ; je = G%jec+halo + endif + + if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then + do j=js,je ; do i=is,ie + h_MLD(i,j) = GV%Z_to_H * MLD_in(i,j) + enddo ; enddo + else ! The fully non-Boussinesq conversion between height in MLD_in and thickness. + if ((allocated(tv%SpV_avg)) .and. (tv%valid_SpV_halo < halos)) then + if (tv%valid_SpV_halo < 0) then + mesg = "invalid values of SpV_avg." + else + write(mesg, '("insufficiently large SpV_avg halos of width ", i2, " but ", i2," is needed.")') & + tv%valid_SpV_halo, halos + endif + call MOM_error(FATAL, "convert_MLD_to_ML_thickness called in fully non-Boussinesq mode with "//trim(mesg)) + endif + + do j=js,je + do i=is,ie ; MLD_rem(i) = MLD_in(i,j) ; h_MLD(i,j) = 0.0 ; enddo + do k=1,nz + keep_going = .false. + do i=is,ie ; if (MLD_rem(i) > 0.0) then + if (MLD_rem(i) > GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)) then + h_MLD(i,j) = h_MLD(i,j) + h(i,j,k) + MLD_rem(i) = MLD_rem(i) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) + keep_going = .true. + else + h_MLD(i,j) = h_MLD(i,j) + GV%RZ_to_H * MLD_rem(i) / tv%SpV_avg(i,j,k) + MLD_rem(i) = 0.0 + endif + endif ; enddo + if (.not.keep_going) exit + enddo + enddo + endif + +end subroutine convert_MLD_to_ML_thickness + end module MOM_interface_heights From 2035af3d2d12e3cbc4885f893d91c9fabdc5a5ba Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Apr 2024 06:46:59 -0400 Subject: [PATCH 12/21] +*Use thickness in ideal_age_tracer_column_physics Pass mixed layer thickness, rather than mixed layer depth, to ideal_age_tracer_column_physics, and determine the number of layers within the mixed layer in count_BL_layers in thickness units rather than depth units. To accommodate these changes there is now a call to convert_MLD_to_ML_thickness inside of call_tracer_column_fns. The thermo_var_ptrs type argument (tv) to ideal_age_tracer_column_physics and count_BL_layers are no longer used and have been removed. All answers are bitwise identical in Boussinesq mode, but in non-Boussinesq mode there are changes in the passive ideal age tracers at the level of roundoff. There are also changes in the units of arguments and the number of arguments to a public interface. --- src/tracer/MOM_tracer_flow_control.F90 | 27 +++++++++++++++--------- src/tracer/ideal_age_example.F90 | 29 +++++++++++--------------- 2 files changed, 29 insertions(+), 27 deletions(-) diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 6d035e1d27..10aba675da 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -11,6 +11,7 @@ module MOM_tracer_flow_control use MOM_get_input, only : Get_MOM_input use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type +use MOM_interface_heights, only : convert_MLD_to_ML_thickness use MOM_CVMix_KPP, only : KPP_CS use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : MOM_restart_CS @@ -427,7 +428,7 @@ subroutine call_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, G end subroutine call_tracer_set_forcing !> This subroutine calls all registered tracer column physics subroutines. -subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, US, tv, optics, CS, & +subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, US, tv, optics, CS, & debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. @@ -444,7 +445,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, type(forcing), intent(in) :: fluxes !< A structure containing pointers to !! any possible forcing fields. !! Unused fields have NULL ptrs. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hml !< Mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: mld !< Mixed layer depth [Z ~> m] real, intent(in) :: dt !< The amount of time covered by this !! call [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -464,6 +465,9 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over !! which fluxes can be applied [H ~> m or kg m-2] + ! Local variables + real :: Hbl(SZI_(G),SZJ_(G)) !< Boundary layer thickness [H ~> m or kg m-2] + if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -488,12 +492,13 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, G, GV, US, CS%RGC_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) - if (CS%use_ideal_age) & + if (CS%use_ideal_age) then + call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, tv, CS%ideal_age_tracer_CSp, & + G, GV, US, CS%ideal_age_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & - minimum_forcing_depth=minimum_forcing_depth, & - Hbl=Hml) + minimum_forcing_depth=minimum_forcing_depth, Hbl=Hbl) + endif if (CS%use_regional_dyes) & call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, tv, CS%dye_tracer_CSp, & @@ -526,7 +531,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, mld, dt, & G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) @@ -567,9 +572,11 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (CS%use_RGC_tracer) & call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%RGC_tracer_CSp) - if (CS%use_ideal_age) & + if (CS%use_ideal_age) then + call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, tv, CS%ideal_age_tracer_CSp, Hbl=Hml) + G, GV, US, CS%ideal_age_tracer_CSp, Hbl=Hbl) + endif if (CS%use_regional_dyes) & call dye_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, tv, CS%dye_tracer_CSp) @@ -591,7 +598,7 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, if (US%QRZ_T_to_W_m2 /= 1.0) call MOM_error(FATAL, "MOM_generic_tracer_column_physics "//& "has not been written to permit dimensionsal rescaling. Set all 4 of the "//& "[QRZT]_RESCALE_POWER parameters to 0.") - call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, Hml, dt, & + call MOM_generic_tracer_column_physics(h_old, h_new, ea, eb, fluxes, mld, dt, & G, GV, US, CS%MOM_generic_tracer_CSp, tv, optics) endif if (CS%use_pseudo_salt_tracer) & diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 1d04e94589..4323479823 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -12,7 +12,6 @@ module ideal_age_example use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, MOM_read_data, slasher, vardesc, var_desc, query_vardesc -use MOM_interface_heights, only : thickness_to_dz use MOM_open_boundary, only : ocean_OBC_type use MOM_restart, only : query_initialized, set_initialized, MOM_restart_CS use MOM_spatial_means, only : global_mass_int_EFP @@ -22,7 +21,7 @@ module ideal_age_example use MOM_tracer_diabatic, only : tracer_vertdiff, applyTracerBoundaryFluxesInOut use MOM_tracer_Z_init, only : tracer_Z_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface, thermo_var_ptrs +use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -297,7 +296,7 @@ subroutine initialize_ideal_age_tracer(restart, day, G, GV, US, h, diag, OBC, CS end subroutine initialize_ideal_age_tracer !> Applies diapycnal diffusion, aging and regeneration at the surface to the ideal age tracers -subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, tv, CS, & +subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, & evap_CFL_limit, minimum_forcing_depth, Hbl) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure @@ -317,14 +316,13 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, !! and tracer forcing fields. Unused fields have NULL ptrs. real, intent(in) :: dt !< The amount of time covered by this call [T ~> s] type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables type(ideal_age_tracer_CS), pointer :: CS !< The control structure returned by a previous !! call to register_ideal_age_tracer. real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can !! be fluxed out of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over which !! fluxes can be applied [H ~> m or kg m-2] - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: Hbl !< Boundary layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: Hbl !< Boundary layer thickness [H ~> m or kg m-2] ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. @@ -349,7 +347,7 @@ subroutine ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, endif if (CS%use_real_BL_depth .and. present(Hbl)) then - call count_BL_layers(G, GV, h_old, Hbl, tv, BL_layers) + call count_BL_layers(G, GV, h_old, Hbl, BL_layers) endif if (.not.associated(CS)) return @@ -578,30 +576,27 @@ subroutine ideal_age_example_end(CS) endif end subroutine ideal_age_example_end -subroutine count_BL_layers(G, GV, h, Hbl, tv, BL_layers) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure +subroutine count_BL_layers(G, GV, h, Hbl, BL_layers) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer depth [Z ~> m] - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + intent(in) :: h !< Layer thicknesses [H ~> m or kg m-2]. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Hbl !< Boundary layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G)), intent(out) :: BL_layers !< Number of model layers in the boundary layer [nondim] - real :: dz(SZI_(G),SZK_(GV)) ! Height change across layers [Z ~> m] - real :: current_depth ! Distance from the free surface [Z ~> m] + real :: current_depth ! Distance from the free surface [H ~> m or kg m-2] integer :: i, j, k, is, ie, js, je, nz, m, nk character(len=255) :: msg is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke BL_layers(:,:) = 0. do j=js,je - call thickness_to_dz(h, tv, dz, j, G, GV) do i=is,ie current_depth = 0. do k=1,nz - current_depth = current_depth + dz(i,k) + current_depth = current_depth + h(i,j,k) if (Hbl(i,j) <= current_depth) then - BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / dz(i,k)) + BL_layers(i,j) = BL_layers(i,j) + (1.0 - (current_depth - Hbl(i,j)) / h(i,j,k)) exit else BL_layers(i,j) = BL_layers(i,j) + 1.0 From 912c56883b46d19c180659ad26fba8e3a10c64bc Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Tue, 23 Apr 2024 06:48:40 -0400 Subject: [PATCH 13/21] +Pass h_MLD to mixedlayer_restrat Provide the mixed layer thickness, as well as the mixed layer depth as arguments to mixedlayer_restrat. The code that had previously been used to convert between the two has now been removed to the new external function convert_MLD_to_ML_thickness. To accommodate these changes, a new element, h_ML, was added to the vertvisc type, and a call to convert_MLD_to_ML_thickness was temporarily added in step_MOM_dynamics just before the call to mixedlayer_restrat. All answers are bitwise identical, but there are changes to a public interface. --- src/core/MOM.F90 | 7 +- src/core/MOM_variables.F90 | 3 +- .../lateral/MOM_mixed_layer_restrat.F90 | 97 ++++++------------- 3 files changed, 35 insertions(+), 72 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0b602be944..0f3274c2f3 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -98,6 +98,7 @@ 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, calc_derived_thermo, thickness_to_dz +use MOM_interface_heights, only : convert_MLD_to_ML_thickness use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end use MOM_interface_filter, only : interface_filter_CS use MOM_internal_tides, only : int_tide_CS @@ -1327,7 +1328,11 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) - call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, & + if (associated(CS%visc%MLD)) then + call safe_alloc_ptr(CS%visc%h_ML, G%isd, G%ied, G%jsd, G%jed) + call convert_MLD_to_ML_thickness(CS%visc%MLD, h, CS%visc%h_ML, CS%tv, G, GV, halo=1) + endif + call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, CS%visc%h_ML, & CS%visc%sfc_buoy_flx, CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) call pass_var(h, G%Domain, clock=id_clock_pass, halo=max(2,CS%cont_stencil)) diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index cb20837d3b..2510ff95a5 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -263,7 +263,8 @@ module MOM_variables Ray_v !< The Rayleigh drag velocity to be applied to each layer at v-points [H T-1 ~> m s-1 or Pa s m-1]. ! The following elements are pointers so they can be used as targets for pointers in the restart registry. - real, pointer, dimension(:,:) :: MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. + real, pointer, dimension(:,:) :: MLD => NULL() !< Instantaneous active mixing layer depth [Z ~> m]. + real, pointer, dimension(:,:) :: h_ML => NULL() !< Instantaneous active mixing layer thickness [H ~> m or kg m-2]. real, pointer, dimension(:,:) :: sfc_buoy_flx => NULL() !< Surface buoyancy flux (derived) [Z2 T-3 ~> m2 s-3]. real, pointer, dimension(:,:,:) :: Kd_shear => NULL() !< The shear-driven turbulent diapycnal diffusivity at the interfaces between layers diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 327d18cc7c..e7ada31430 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -132,7 +132,7 @@ module MOM_mixed_layer_restrat !> Driver for the mixed-layer restratification parameterization. !! The code branches between two different implementations depending !! on whether the bulk-mixed layer or a general coordinate are in use. -subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, bflux, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, h_MLD, bflux, VarMix, G, GV, US, CS) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -146,11 +146,15 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, bflux, VarMix, real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by the !! planetary boundary layer scheme [Z ~> m] + real, dimension(:,:), pointer :: h_MLD !< Mixed layer thickness provided + !! by the planetary boundary layer + !! scheme [H ~> m or kg m-2] real, dimension(:,:), pointer :: bflux !< Surface buoyancy flux provided by the !! PBL scheme [Z2 T-3 ~> m2 s-3] type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure + if (.not. CS%initialized) call MOM_error(FATAL, "mixedlayer_restrat: "// & "Module must be initialized before it is used.") @@ -159,16 +163,16 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, bflux, VarMix, call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, forces, dt, G, GV, US, CS) elseif (CS%use_Bodner) then ! Implementation of Bodner et al., 2023 - call mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, MLD, bflux) + call mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, MLD, h_MLD, bflux) else ! Implementation of Fox-Kemper et al., 2008, to work in general coordinates - call mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD, VarMix, G, GV, US, CS) + call mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, G, GV, US, CS) endif end subroutine mixedlayer_restrat !> Calculates a restratifying flow in the mixed layer, following the formulation used in OM4 -subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, G, GV, US, CS) +subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, G, GV, US, CS) ! Arguments type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure @@ -181,8 +185,9 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure type(mech_forcing), intent(in) :: forces !< A structure with the driving mechanical forces real, intent(in) :: dt !< Time increment [T ~> s] - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by the - !! PBL scheme [Z ~> m] + real, dimension(:,:), pointer :: h_MLD !< Thickness of water within the + !! mixed layer depth provided by + !! the PBL scheme [H ~> m or kg m-2] type(VarMix_CS), intent(in) :: VarMix !< Variable mixing control structure type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure @@ -212,8 +217,6 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1] real :: SpV_int_fast(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m] real :: SpV_int_slow(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m] - real :: H_mld(SZI_(G)) ! The thickness of water within the topmost MLD_in of height [H ~> m or kg m-2] - real :: MLD_rem(SZI_(G)) ! The vertical extent of the MLD_in that has not yet been accounted for [Z ~> m] real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2] @@ -326,30 +329,9 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, enddo enddo ! j-loop elseif (CS%MLE_use_PBL_MLD) then - if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then - do j=js-1,je+1 ; do i=is-1,ie+1 - MLD_fast(i,j) = CS%MLE_MLD_stretch * GV%Z_to_H * MLD_in(i,j) - enddo ; enddo - else ! The fully non-Boussinesq conversion between height in MLD_in and thickness. - do j=js-1,je+1 - do i=is-1,ie+1 ; MLD_rem(i) = MLD_in(i,j) ; H_mld(i) = 0.0 ; enddo - do k=1,nz - keep_going = .false. - do i=is-1,ie+1 ; if (MLD_rem(i) > 0.0) then - if (MLD_rem(i) > GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)) then - H_mld(i) = H_mld(i) + h(i,j,k) - MLD_rem(i) = MLD_rem(i) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) - keep_going = .true. - else - H_mld(i) = H_mld(i) + GV%RZ_to_H * MLD_rem(i) / tv%SpV_avg(i,j,k) - MLD_rem(i) = 0.0 - endif - endif ; enddo - if (.not.keep_going) exit - enddo - do i=is-1,ie+1 ; MLD_fast(i,j) = CS%MLE_MLD_stretch * H_mld(i) ; enddo - enddo - endif + do j=js-1,je+1 ; do i=is-1,ie+1 + MLD_fast(i,j) = CS%MLE_MLD_stretch * h_MLD(i,j) + enddo ; enddo else call MOM_error(FATAL, "mixedlayer_restrat_OM4: "// & "No MLD to use for MLE parameterization.") @@ -359,7 +341,7 @@ subroutine mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, MLD_in, VarMix, if (CS%MLE_MLD_decay_time>0.) then if (CS%debug) then call hchksum(CS%MLD_filtered, 'mixed_layer_restrat: MLD_filtered', G%HI, haloshift=1, scale=GV%H_to_mks) - call hchksum(MLD_in, 'mixed_layer_restrat: MLD in', G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(h_MLD, 'mixed_layer_restrat: MLD in', G%HI, haloshift=1, scale=GV%H_to_mks) endif aFac = CS%MLE_MLD_decay_time / ( dt + CS%MLE_MLD_decay_time ) bFac = dt / ( dt + CS%MLE_MLD_decay_time ) @@ -776,7 +758,7 @@ end function mu !> Calculates a restratifying flow in the mixed layer, following the formulation !! used in Bodner et al., 2023 (B22) -subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, BLD, bflux) +subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, BLD, h_MLD, bflux) ! Arguments type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure @@ -792,6 +774,9 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d real, intent(in) :: dt !< Time increment [T ~> s] real, dimension(:,:), pointer :: BLD !< Active boundary layer depth provided by the !! PBL scheme [Z ~> m] (not H) + real, dimension(:,:), pointer :: h_MLD !< Thickness of water within the + !! active boundary layer depth provided by + !! the PBL scheme [H ~> m or kg m-2] real, dimension(:,:), pointer :: bflux !< Surface buoyancy flux provided by the !! PBL scheme [Z2 T-3 ~> m2 s-3] ! Local variables @@ -812,16 +797,12 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d real :: U_star_2d(SZI_(G),SZJ_(G)) ! The wind friction velocity, calculated using the Boussinesq ! reference density or the time-evolving surface density in non-Boussinesq ! mode [Z T-1 ~> m s-1] - real :: BLD_in_H(SZI_(G)) ! The thickness of the active boundary layer with the topmost BLD of - ! height [H ~> m or kg m-2] real :: covTS(SZI_(G)) ! SGS TS covariance in Stanley param; currently 0 [C S ~> degC ppt] real :: varS(SZI_(G)) ! SGS S variance in Stanley param; currently 0 [S2 ~> ppt2] real :: dmu(SZK_(GV)) ! Change in mu(z) across layer k [nondim] real :: Rml_int(SZI_(G)) ! Potential density integrated through the mixed layer [R H ~> kg m-2 or kg2 m-5] real :: SpV_ml(SZI_(G)) ! Specific volume evaluated at the surface pressure [R-1 ~> m3 kg-1] real :: SpV_int(SZI_(G)) ! Specific volume integrated through the mixed layer [H R-1 ~> m4 kg-1 or m] - real :: H_mld(SZI_(G)) ! The thickness of water within the topmost BLD of height [H ~> m or kg m-2] - real :: MLD_rem(SZI_(G)) ! The vertical extent of the BLD that has not yet been accounted for [Z ~> m] real :: rho_ml(SZI_(G)) ! Potential density relative to the surface [R ~> kg m-3] real :: p0(SZI_(G)) ! A pressure of 0 [R L2 T-2 ~> Pa] real :: g_Rho0 ! G_Earth/Rho0 times a thickness conversion factor @@ -886,7 +867,8 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d if (CS%debug) then call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, scale=GV%H_to_mks) - call hchksum(BLD, 'mle_Bodner: BLD in', G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(BLD, 'mle_Bodner: BLD', G%HI, haloshift=1, scale=US%Z_to_m) + call hchksum(h_MLD, 'mle_Bodner: h_MLD', G%HI, haloshift=1, scale=GV%H_to_mks) if (associated(bflux)) & call hchksum(bflux, 'mle_Bodner: bflux', G%HI, haloshift=1, scale=US%Z_to_m**2*US%s_to_T**3) call hchksum(U_star_2d, 'mle_Bodner: u*', G%HI, haloshift=1, scale=US%Z_to_m*US%s_to_T) @@ -896,38 +878,13 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d G%HI, haloshift=1, scale=GV%H_to_mks) endif - ! Apply time filter to BLD (to remove diurnal cycle) to obtain "little h". + ! Apply time filter to h_MLD (to remove diurnal cycle) to obtain "little h". ! "little h" is representative of the active mixing layer depth, used in B22 formula (eq 27). - if (GV%Boussinesq .or. (.not.allocated(tv%SpV_avg))) then - do j=js-1,je+1 ; do i=is-1,ie+1 - little_h(i,j) = rmean2ts(GV%Z_to_H*BLD(i,j), CS%MLD_filtered(i,j), & - CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt) - CS%MLD_filtered(i,j) = little_h(i,j) - enddo ; enddo - else ! The fully non-Boussinesq conversion between height in BLD and thickness. - do j=js-1,je+1 - do i=is-1,ie+1 ; MLD_rem(i) = BLD(i,j) ; H_mld(i) = 0.0 ; enddo - do k=1,nz - keep_going = .false. - do i=is-1,ie+1 ; if (MLD_rem(i) > 0.0) then - if (MLD_rem(i) > GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k)) then - H_mld(i) = H_mld(i) + h(i,j,k) - MLD_rem(i) = MLD_rem(i) - GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) - keep_going = .true. - else - H_mld(i) = H_mld(i) + GV%RZ_to_H * MLD_rem(i) / tv%SpV_avg(i,j,k) - MLD_rem(i) = 0.0 - endif - endif ; enddo - if (.not.keep_going) exit - enddo - do i=is-1,ie+1 - little_h(i,j) = rmean2ts(H_mld(i), CS%MLD_filtered(i,j), & - CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt) - CS%MLD_filtered(i,j) = little_h(i,j) - enddo - enddo - endif + do j=js-1,je+1 ; do i=is-1,ie+1 + little_h(i,j) = rmean2ts(h_MLD(i,j), CS%MLD_filtered(i,j), & + CS%BLD_growing_Tfilt, CS%BLD_decaying_Tfilt, dt) + CS%MLD_filtered(i,j) = little_h(i,j) + enddo ; enddo ! Calculate "big H", representative of the mixed layer depth, used in B22 formula (eq 27). do j=js-1,je+1 ; do i=is-1,ie+1 From c3002089f9255351c599b7c197027ee128ce6a0b Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 24 Apr 2024 05:37:10 -0400 Subject: [PATCH 14/21] +*Convert MLD to ML_thickness in diabatic Moved the call to convert mixed layer depths into mixed layer thicknesses from right before the call to mixedlayer_restrat into the various diabatic routines just after they are calculated. This code rearrangement changes answers in non-Boussinesq mode because the layer specific volumes will have evolved between these two calls, but it is consistent with the mixed layer thicknesses as used in the boundary layer parameterizations. A new argument was added to bulkmixedlayer to return the mixed layer thickness that was already being calculated. The previous argument Hml was renamed to BLD and changed from a pointer into a simple array. Both are intent(inout) rather than intent(out) to preserve values in halos. This commit also revises the logic around the allocation of visc%h_ML and its registration as a restart variable, including handling cases where an older restart file is being read that includes MLD but not h_ML. Because the mixed layer depth is used in almost cases, CS%Hml in the control structure for MOM.F90 was changed from a pointer to an allocatable, with values of 0 in those cases (e.g., when ADIABATIC is true) where it is not used. In addition, the argument Hml to the various diabatic routines was changed to MLD to more clearly reflect that it is a depth and not a thickness. Outside of diabatic, BML is only used to provide the tracer point boundary layer depths to the calling routines, so it does not need a halo update. Instead, all of the halo updates for the various elements of visc that do need halo updates after the diabatic calls are collected into one place for efficiency and more accurate timings. The scale arguments of 34 checksum calls were revised from GV%H_to_m to GV%H_to_MKS for more accurate checksums in non-Boussinesq configurations by avoiding multiplication by an reference specific volume, and instead only rescaling by an integer power of 2. All answers are bitwise identical in Boussinesq mode, but in non-Boussinesq mode there are changes in answers in cases that use the boundary layer thicknesses obtained from the boundary layer parameterizations in subsequent calculations, such as mixed layer restratification with some options. There are also changes to the arguments of several publicly visible routines. --- src/core/MOM.F90 | 36 ++-- .../vertical/MOM_bulk_mixed_layer.F90 | 41 ++-- .../vertical/MOM_diabatic_driver.F90 | 198 ++++++++---------- .../vertical/MOM_set_viscosity.F90 | 7 +- 4 files changed, 138 insertions(+), 144 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0f3274c2f3..ad26b10013 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -98,7 +98,6 @@ 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, calc_derived_thermo, thickness_to_dz -use MOM_interface_heights, only : convert_MLD_to_ML_thickness use MOM_interface_filter, only : interface_filter, interface_filter_init, interface_filter_end use MOM_interface_filter, only : interface_filter_CS use MOM_internal_tides, only : int_tide_CS @@ -212,8 +211,8 @@ module MOM real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: eta_av_bc !< free surface height or column mass time averaged over the last !! baroclinic dynamics time step [H ~> m or kg m-2] - real, dimension(:,:), pointer :: & - Hml => NULL() !< active mixed layer depth [Z ~> m] + real, dimension(:,:), pointer :: Hml => NULL() + !< active mixed layer depth, or 0 if there is no boundary layer scheme [Z ~> m] real :: time_in_cycle !< The running time of the current time-stepping cycle !! in calls that step the dynamics, and also the length of !! the time integral of ssh_rint [T ~> s]. @@ -1328,10 +1327,6 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_thermo, & CS%uhtr, CS%vhtr, G%HI, haloshift=0, scale=GV%H_to_MKS*US%L_to_m**2) endif call cpu_clock_begin(id_clock_ml_restrat) - if (associated(CS%visc%MLD)) then - call safe_alloc_ptr(CS%visc%h_ML, G%isd, G%ied, G%jsd, G%jed) - call convert_MLD_to_ML_thickness(CS%visc%MLD, h, CS%visc%h_ML, CS%tv, G, GV, halo=1) - endif call mixedlayer_restrat(h, CS%uhtr, CS%vhtr, CS%tv, forces, dt, CS%visc%MLD, CS%visc%h_ML, & CS%visc%sfc_buoy_flx, CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) @@ -2129,6 +2124,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & logical :: Boussinesq ! If true, this run is fully Boussinesq logical :: semi_Boussinesq ! If true, this run is partially non-Boussinesq logical :: use_KPP ! If true, diabatic is using KPP vertical mixing + logical :: MLE_use_PBL_MLD ! If true, use stored boundary layer depths for submesoscale restratification. integer :: nkml, nkbl, verbosity, write_geom integer :: dynamics_stencil ! The computational stencil for the calculations ! in the dynamic core. @@ -2733,7 +2729,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & if (use_frazil) allocate(CS%tv%frazil(isd:ied,jsd:jed), source=0.0) if (bound_salinity) allocate(CS%tv%salt_deficit(isd:ied,jsd:jed), source=0.0) - if (bulkmixedlayer .or. use_temperature) allocate(CS%Hml(isd:ied,jsd:jed), source=0.0) + allocate(CS%Hml(isd:ied,jsd:jed), source=0.0) if (bulkmixedlayer) then GV%nkml = nkml ; GV%nk_rho_varies = nkml + nkbl @@ -3275,11 +3271,23 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & CS%mixedlayer_restrat = mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, & CS%mixedlayer_restrat_CSp, restart_CSp) if (CS%mixedlayer_restrat) then + if (GV%Boussinesq .and. associated(CS%visc%h_ML)) then + ! This is here to allow for a transition of restart files between model versions. + call get_param(param_file, "MOM", "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & + default=.false., do_not_log=.true.) + if (MLE_use_PBL_MLD .and. .not.query_initialized(CS%visc%h_ML, "h_ML", restart_CSp) .and. & + associated(CS%visc%MLD)) then + do j=js,je ; do i=is,ie ; CS%visc%h_ML(i,j) = GV%Z_to_H * CS%visc%MLD(i,j) ; enddo ; enddo + endif + endif + if (.not.(bulkmixedlayer .or. CS%use_ALE_algorithm)) & call MOM_error(FATAL, "MOM: MIXEDLAYER_RESTRAT true requires a boundary layer scheme.") ! When DIABATIC_FIRST=False and using CS%visc%ML in mixedlayer_restrat we need to update after a restart if (.not. CS%diabatic_first .and. associated(CS%visc%MLD)) & call pass_var(CS%visc%MLD, G%domain, halo=1) + if (.not. CS%diabatic_first .and. associated(CS%visc%h_ML)) & + call pass_var(CS%visc%h_ML, G%domain, halo=1) endif call MOM_diagnostics_init(MOM_internal_state, CS%ADp, CS%CDp, Time, G, GV, US, & @@ -3571,7 +3579,7 @@ subroutine set_restart_fields(GV, US, param_file, CS, restart_CSp) ! hML is needed when using the ice shelf module call get_param(param_file, '', "ICE_SHELF", use_ice_shelf, default=.false., & do_not_log=.true.) - if (use_ice_shelf .and. associated(CS%Hml)) then + if (use_ice_shelf) then call register_restart_field(CS%Hml, "hML", .false., restart_CSp, & "Mixed layer thickness", "m", conversion=US%Z_to_m) endif @@ -3711,11 +3719,9 @@ subroutine extract_surface_state(CS, sfc_state_in) enddo ; enddo ; endif ! copy Hml into sfc_state, so that caps can access it - if (associated(CS%Hml)) then - do j=js,je ; do i=is,ie - sfc_state%Hml(i,j) = CS%Hml(i,j) - enddo ; enddo - endif + do j=js,je ; do i=is,ie + sfc_state%Hml(i,j) = CS%Hml(i,j) + enddo ; enddo if (CS%Hmix < 0.0) then ! A bulk mixed layer is in use, so layer 1 has the properties if (use_temperature) then ; do j=js,je ; do i=is,ie @@ -3880,7 +3886,7 @@ subroutine extract_surface_state(CS, sfc_state_in) do k=1,nz call calculate_TFreeze(CS%tv%S(is:ie,j,k), pres(is:ie), T_freeze(is:ie), CS%tv%eqn_of_state) do i=is,ie - depth_ml = min(CS%HFrz, (US%Z_to_m*GV%m_to_H)*CS%visc%MLD(i,j)) + depth_ml = min(CS%HFrz, CS%visc%h_ML(i,j)) if (depth(i) + h(i,j,k) < depth_ml) then dh = h(i,j,k) elseif (depth(i) < depth_ml) then diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index f2b38c4a29..561ace60a7 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -164,7 +164,7 @@ module MOM_bulk_mixed_layer !> This subroutine partially steps the bulk mixed layer model. !! See \ref BML for more details. subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, CS, & - optics, Hml, aggregate_FW_forcing, dt_diag, last_call) + optics, BLD, H_ml, aggregate_FW_forcing, dt_diag, last_call) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -195,7 +195,10 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C type(optics_type), pointer :: optics !< The structure that can be queried for the !! inverse of the vertical absorption decay !! scale for penetrating shortwave radiation. - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: BLD !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: H_ml !< Active mixed layer thickness [H ~> m or kg m-2]. logical, intent(in) :: aggregate_FW_forcing !< If true, the net incoming and !! outgoing surface freshwater fluxes are !! combined before being applied, instead of @@ -605,25 +608,27 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, US, C CS%ML_depth(i,j) = h(i,0) ! Store the diagnostic. enddo ; endif - if (associated(Hml)) then - ! Return the mixed layerd depth in [Z ~> m]. - if (GV%Boussinesq .or. GV%semi_Boussinesq) then - do i=is,ie - Hml(i,j) = G%mask2dT(i,j) * GV%H_to_Z*h(i,0) - enddo + ! Return the mixed layer depth in [Z ~> m]. + if (GV%Boussinesq .or. GV%semi_Boussinesq) then + do i=is,ie + BLD(i,j) = G%mask2dT(i,j) * GV%H_to_Z*h(i,0) + enddo + else + do i=is,ie ; dp_ml(i) = GV%g_Earth * GV%H_to_RZ * h(i,0) ; enddo + if (associated(tv%p_surf)) then + do i=is,ie ; p_sfc(i) = tv%p_surf(i,j) ; enddo else - do i=is,ie ; dp_ml(i) = GV%g_Earth * GV%H_to_RZ * h(i,0) ; enddo - if (associated(tv%p_surf)) then - do i=is,ie ; p_sfc(i) = tv%p_surf(i,j) ; enddo - else - do i=is,ie ; p_sfc(i) = 0.0 ; enddo - endif - call average_specific_vol(T(:,0), S(:,0), p_sfc, dp_ml, SpV_ml, tv%eqn_of_state) - do i=is,ie - Hml(i,j) = G%mask2dT(i,j) * GV%H_to_RZ * SpV_ml(i) * h(i,0) - enddo + do i=is,ie ; p_sfc(i) = 0.0 ; enddo endif + call average_specific_vol(T(:,0), S(:,0), p_sfc, dp_ml, SpV_ml, tv%eqn_of_state) + do i=is,ie + BLD(i,j) = G%mask2dT(i,j) * GV%H_to_RZ * SpV_ml(i) * h(i,0) + enddo endif + ! Return the mixed layer thickness in [H ~> m or kg m-2]. + do i=is,ie + H_ml(i,j) = G%mask2dT(i,j) * h(i,0) + enddo ! At this point, return water to the original layers, but constrained to ! still be sorted. After this point, all the water that is in massive diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 010f17b978..4f4c605a11 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -45,6 +45,7 @@ module MOM_diabatic_driver use MOM_int_tide_input, only : set_int_tide_input, int_tide_input_init use MOM_int_tide_input, only : int_tide_input_end, int_tide_input_CS, int_tide_input_type use MOM_interface_heights, only : find_eta, calc_derived_thermo, thickness_to_dz +use MOM_interface_heights, only : convert_MLD_to_ML_thickness use MOM_internal_tides, only : propagate_int_tide, register_int_tide_restarts use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used @@ -242,8 +243,7 @@ module MOM_diabatic_driver type(regularize_layers_CS) :: regularize_layers !< Regularize layer control structure type(group_pass_type) :: pass_hold_eb_ea !< For group halo pass - type(group_pass_type) :: pass_Kv !< For group halo pass - type(diag_grid_storage) :: diag_grids_prev!< Stores diagnostic grids at some previous point in the algorithm + type(diag_grid_storage) :: diag_grids_prev !< Stores diagnostic grids at some previous point in the algorithm type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) end type diabatic_CS @@ -259,7 +259,7 @@ module MOM_diabatic_driver !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, stoch_CS, OBC, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -268,7 +268,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, @@ -389,18 +389,23 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & endif ! end CS%use_int_tides if (CS%useALEalgorithm .and. CS%use_legacy_diabatic) then - call diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, stoch_CS, Waves) elseif (CS%useALEalgorithm) then - call diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + call diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, stoch_CS, Waves) else - call layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & + call layered_diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) endif - call cpu_clock_begin(id_clock_pass) + if (associated(visc%sfc_buoy_flx)) & + call pass_var(visc%sfc_buoy_flx, G%domain, halo=1, complete=.not.associated(visc%MLD)) + if (associated(visc%h_ML)) & + call pass_var(visc%h_ML, G%Domain, halo=1, complete=.not.associated(visc%MLD)) + if (associated(visc%MLD)) & + call pass_var(visc%MLD, G%Domain, halo=1, complete=.true.) if (associated(visc%Kv_shear)) & call pass_var(visc%Kv_shear, G%Domain, To_All+Omit_Corners, halo=1) call cpu_clock_end(id_clock_pass) @@ -499,7 +504,7 @@ end subroutine diabatic !> Applies diabatic forcing and diapycnal mixing of temperature, salinity and other tracers for use !! with an ALE algorithm. This version uses an older set of algorithms compared with diabatic_ALE. -subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, stoch_CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -509,7 +514,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, @@ -697,16 +702,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif - if (associated(Hml)) then - call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G, US) - call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy KPP's BLD into it - if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) - endif - if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) - call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) - endif + call KPP_get_BLD(CS%KPP_CSp, BLD(:,:), G, US) + ! If visc%MLD or visc%h_ML exist, copy KPP's BLD into them with appropriate conversions. + if (associated(visc%h_ML)) call convert_MLD_to_ML_thickness(BLD, h, visc%h_ML, tv, G, GV) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) + if (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) if (.not.CS%KPPisPassive) then !$OMP parallel do default(shared) @@ -779,7 +779,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, BLD, Kd_int, visc%Kv_shear) endif ! Find the vertical distances across layers. @@ -802,7 +802,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) - call hchksum(ent_s, "after calc_entrain ent_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_s, "after calc_entrain ent_s", G%HI, haloshift=0, scale=GV%H_to_MKS) endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -847,19 +847,11 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) - call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy ePBL's MLD into it - if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) - elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) - call pass_var(visc%MLD, G%domain, halo=1) - endif - if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) - call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) - endif + call energetic_PBL_get_MLD(CS%ePBL, BLD(:,:), G, US) + ! If visc%MLD or visc%h_ML exist, copy ePBL's BLD into them with appropriate conversions. + if (associated(visc%h_ML)) call convert_MLD_to_ML_thickness(BLD, h, visc%h_ML, tv, G, GV) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) + if (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) ! Find the vertical distances across layers, which may have been modified by the net surface flux call thickness_to_dz(h, tv, dz, G, GV, US) @@ -885,8 +877,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim enddo ; enddo ; enddo if (CS%debug) then - call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_MKS) call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif @@ -930,8 +922,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim if (associated(tv%T)) then if (CS%debug) then - call hchksum(ent_t, "before triDiagTS ent_t ", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "before triDiagTS ent_s ", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "before triDiagTS ent_t ", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(ent_s, "before triDiagTS ent_s ", G%HI, haloshift=0, scale=GV%H_to_MKS) endif call cpu_clock_begin(id_clock_tridiag) @@ -1076,7 +1068,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Tim endif ! (CS%mix_boundary_tracers) ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & + call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, BLD, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar, & @@ -1119,7 +1111,7 @@ end subroutine diabatic_ALE_legacy !> This subroutine imposes the diapycnal mass fluxes and the !! accompanying diapycnal advection of momentum and tracers. -subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & +subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, stoch_CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1129,7 +1121,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, @@ -1322,16 +1314,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif - if (associated(Hml)) then - call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G, US) - call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy KPP's BLD into it - if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) - endif - if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) - call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) - endif + call KPP_get_BLD(CS%KPP_CSp, BLD(:,:), G, US) + ! If visc%MLD or visc%h_ML exist, copy KPP's BLD into them with appropriate conversions. + if (associated(visc%h_ML)) call convert_MLD_to_ML_thickness(BLD, h, visc%h_ML, tv, G, GV) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) + if (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then @@ -1367,7 +1354,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, ! Calculate vertical mixing due to convection (computed via CVMix) if (CS%use_CVMix_conv) then ! Increment vertical diffusion and viscosity due to convection - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, BLD, Kd_heat, visc%Kv_shear, Kd_aux=Kd_salt) endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -1393,8 +1380,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD) if (CS%debug) then - call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(ent_s, "after applyBoundaryFluxes ent_s", G%HI, haloshift=0, scale=GV%H_to_MKS) call hchksum(cTKE, "after applyBoundaryFluxes cTKE", G%HI, haloshift=0, & scale=US%RZ3_T3_to_W_m2*US%T_to_s) call hchksum(dSV_dT, "after applyBoundaryFluxes dSV_dT", G%HI, haloshift=0, & @@ -1407,19 +1394,11 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, call energetic_PBL(h, u_h, v_h, tv, fluxes, dt, Kd_ePBL, G, GV, US, & CS%ePBL, stoch_CS, dSV_dT, dSV_dS, cTKE, SkinBuoyFlux, waves=waves) - if (associated(Hml)) then - call energetic_PBL_get_MLD(CS%ePBL, Hml(:,:), G, US) - call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy ePBL's MLD into it - if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) - elseif (associated(visc%MLD)) then - call energetic_PBL_get_MLD(CS%ePBL, visc%MLD, G, US) - call pass_var(visc%MLD, G%domain, halo=1) - endif - if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) - call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) - endif + call energetic_PBL_get_MLD(CS%ePBL, BLD(:,:), G, US) + ! If visc%MLD or visc%h_ML exist, copy ePBL's BLD into them with appropriate conversions. + if (associated(visc%h_ML)) call convert_MLD_to_ML_thickness(BLD, h, visc%h_ML, tv, G, GV) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) + if (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = SkinBuoyFlux(:,:) ! Augment the diffusivities and viscosity due to those diagnosed in energetic_PBL. do K=2,nz ; do j=js,je ; do i=is,ie @@ -1436,8 +1415,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, enddo ; enddo ; enddo if (CS%debug) then - call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "after ePBL ent_t", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(ent_s, "after ePBL ent_s", G%HI, haloshift=0, scale=GV%H_to_MKS) call hchksum(Kd_ePBL, "after ePBL Kd_ePBL", G%HI, haloshift=0, scale=GV%HZ_T_to_m2_s) endif @@ -1473,8 +1452,8 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, if (associated(tv%T)) then if (CS%debug) then - call hchksum(ent_t, "before triDiagTS ent_t ", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(ent_s, "before triDiagTS ent_s ", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ent_t, "before triDiagTS ent_t ", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(ent_s, "before triDiagTS ent_s ", G%HI, haloshift=0, scale=GV%H_to_MKS) endif call cpu_clock_begin(id_clock_tridiag) @@ -1603,7 +1582,7 @@ subroutine diabatic_ALE(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, endif ! (CS%mix_boundary_tracer_ALE) ! For passive tracers, the changes in thickness due to boundary fluxes has yet to be applied - call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, Hml, dt, & + call call_tracer_column_fns(h_orig, h, ent_s(:,:,1:nz), ent_s(:,:,2:nz+1), fluxes, BLD, dt, & G, GV, US, tv, CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar, & @@ -1650,7 +1629,7 @@ end subroutine diabatic_ALE !> Imposes the diapycnal mass fluxes and the accompanying diapycnal advection of momentum and tracers !! using the original MOM6 algorithms. -subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_end, & +subroutine layered_diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, & G, GV, US, CS, Waves) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1660,7 +1639,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(inout) :: tv !< points to thermodynamic fields !! unused have NULL ptrs - real, dimension(:,:), pointer :: Hml !< Active mixed layer depth [Z ~> m] + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: BLD !< Active mixed layer depth [Z ~> m] type(forcing), intent(inout) :: fluxes !< points to forcing fields !! unused fields have NULL ptrs type(vertvisc_type), intent(inout) :: visc !< Structure with vertical viscosities, @@ -1691,6 +1670,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e temp_diag, & ! Diagnostic array of previous temperatures [C ~> degC] saln_diag ! Diagnostic array of previous salinity [S ~> ppt] real, dimension(SZI_(G),SZJ_(G)) :: & + h_MLD, & ! Active mixed layer thickness [H ~> m or kg m-2]. U_star, & ! The friction velocity [Z T-1 ~> m s-1]. KPP_temp_flux, & ! KPP effective temperature flux [C H T-1 ~> degC m s-1 or degC kg m-2 s-1] KPP_salt_flux, & ! KPP effective salt flux [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] @@ -1772,7 +1752,6 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e dz_neglect = GV%dZ_subroundoff ; dz_neglect2 = dz_neglect*dz_neglect Kd_heat(:,:,:) = 0.0 ; Kd_salt(:,:,:) = 0.0 - showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("layered_diabatic(), MOM_diabatic_driver.F90") @@ -1826,12 +1805,14 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt*CS%ML_mix_first, & eaml, ebml, G, GV, US, CS%bulkmixedlayer, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.false.) + BLD, h_MLD, CS%aggregate_FW_forcing, dt, last_call=.false.) else ! Changes: h, tv%T, tv%S, eaml and ebml (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt, eaml, ebml, & G, GV, US, CS%bulkmixedlayer, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + BLD, h_MLD, CS%aggregate_FW_forcing, dt, last_call=.true.) + if (associated(visc%h_ML)) visc%h_ML(:,:) = h_MLD(:,:) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) endif ! Keep salinity from falling below a small but positive threshold. @@ -1858,8 +1839,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if ((CS%ML_mix_first > 0.0) .or. CS%use_geothermal) then call find_uv_at_h(u, v, h_orig, u_h, v_h, G, GV, US, eaml, ebml) if (CS%debug) then - call hchksum(eaml, "after find_uv_at_h eaml", G%HI, scale=GV%H_to_m) - call hchksum(ebml, "after find_uv_at_h ebml", G%HI, scale=GV%H_to_m) + call hchksum(eaml, "after find_uv_at_h eaml", G%HI, scale=GV%H_to_MKS) + call hchksum(ebml, "after find_uv_at_h ebml", G%HI, scale=GV%H_to_MKS) endif else call find_uv_at_h(u, v, h, u_h, v_h, G, GV, US) @@ -1947,16 +1928,11 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif - if (associated(Hml)) then - call KPP_get_BLD(CS%KPP_CSp, Hml(:,:), G, US) - call pass_var(Hml, G%domain, halo=1) - ! If visc%MLD exists, copy KPP's BLD into it - if (associated(visc%MLD)) visc%MLD(:,:) = Hml(:,:) - endif - if (associated(visc%sfc_buoy_flx)) then - visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) - call pass_var(visc%sfc_buoy_flx, G%domain, halo=1) - endif + call KPP_get_BLD(CS%KPP_CSp, BLD(:,:), G, US) + ! If visc%MLD or visc%h_ML exist, copy KPP's BLD into them with appropriate conversions. + if (associated(visc%h_ML)) call convert_MLD_to_ML_thickness(BLD, h, visc%h_ML, tv, G, GV) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) + if (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) if (.not. CS%KPPisPassive) then !$OMP parallel do default(shared) @@ -1985,7 +1961,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Add vertical diff./visc. due to convection (computed via CVMix) if (CS%use_CVMix_conv) then - call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, Hml, Kd_int, visc%Kv_shear) + call calculate_CVMix_conv(h, tv, G, GV, US, CS%CVMix_conv, BLD, Kd_int, visc%Kv_shear) endif if (CS%useKPP) then @@ -2051,8 +2027,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e call MOM_forcing_chksum("after calc_entrain ", fluxes, G, US, haloshift=0) call MOM_thermovar_chksum("after calc_entrain ", tv, G, US) call MOM_state_chksum("after calc_entrain ", u, v, h, G, GV, US, haloshift=0) - call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ea, "after calc_entrain ea", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(eb, "after calc_entrain eb", G%HI, haloshift=0, scale=GV%H_to_MKS) endif ! Save fields before boundary forcing is applied for tendency diagnostics @@ -2207,8 +2183,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e eb(i,j,k) = eb(i,j,k) + ebml(i,j,k) enddo ; enddo ; enddo if (CS%debug) then - call hchksum(ea, "after ea = ea + eaml", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "after eb = eb + ebml", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ea, "after ea = ea + eaml", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(eb, "after eb = eb + ebml", G%HI, haloshift=0, scale=GV%H_to_MKS) endif endif @@ -2229,7 +2205,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! Changes: h, tv%T, tv%S, ea and eb (G is also inout???) call bulkmixedlayer(h, u_h, v_h, tv, fluxes, dt_mix, ea, eb, & G, GV, US, CS%bulkmixedlayer, CS%optics, & - Hml, CS%aggregate_FW_forcing, dt, last_call=.true.) + BLD, h_MLD, CS%aggregate_FW_forcing, dt, last_call=.true.) + if (associated(visc%h_ML)) visc%h_ML(:,:) = h_MLD(:,:) + if (associated(visc%MLD)) visc%MLD(:,:) = BLD(:,:) ! Keep salinity from falling below a small but positive threshold. ! This constraint is needed for SIS1 ice model, which can extract @@ -2251,8 +2229,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (associated(tv%T)) then if (CS%debug) then - call hchksum(ea, "before triDiagTS ea ", G%HI, haloshift=0, scale=GV%H_to_m) - call hchksum(eb, "before triDiagTS eb ", G%HI, haloshift=0, scale=GV%H_to_m) + call hchksum(ea, "before triDiagTS ea ", G%HI, haloshift=0, scale=GV%H_to_MKS) + call hchksum(eb, "before triDiagTS eb ", G%HI, haloshift=0, scale=GV%H_to_MKS) endif call cpu_clock_begin(id_clock_tridiag) @@ -2299,8 +2277,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e if (CS%debug) then call MOM_state_chksum("after mixed layer ", u, v, h, G, GV, US, haloshift=0) call MOM_thermovar_chksum("after mixed layer ", tv, G, US) - call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_m) + call hchksum(ea, "after mixed layer ea", G%HI, scale=GV%H_to_MKS) + call hchksum(eb, "after mixed layer eb", G%HI, scale=GV%H_to_MKS) endif call cpu_clock_begin(id_clock_remap) @@ -2401,7 +2379,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar) @@ -2423,13 +2401,13 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e eatr(i,j,k) = ea(i,j,k) + add_ent enddo ; enddo ; enddo - call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, Hml, dt, G, GV, US, tv, & + call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar) else - call call_tracer_column_fns(hold, h, ea, eb, fluxes, Hml, dt, G, GV, US, tv, & + call call_tracer_column_fns(hold, h, ea, eb, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar) @@ -2493,8 +2471,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! mixed layer turbulence is applied elsewhere. if (CS%use_bulkmixedlayer) then if (CS%debug) then - call hchksum(ea, "before net flux rearrangement ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "before net flux rearrangement eb", G%HI, scale=GV%H_to_m) + call hchksum(ea, "before net flux rearrangement ea", G%HI, scale=GV%H_to_MKS) + call hchksum(eb, "before net flux rearrangement eb", G%HI, scale=GV%H_to_MKS) endif !$OMP parallel do default(shared) private(net_ent) do j=js,je @@ -2505,8 +2483,8 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e enddo ; enddo enddo if (CS%debug) then - call hchksum(ea, "after net flux rearrangement ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "after net flux rearrangement eb", G%HI, scale=GV%H_to_m) + call hchksum(ea, "after net flux rearrangement ea", G%HI, scale=GV%H_to_MKS) + call hchksum(eb, "after net flux rearrangement eb", G%HI, scale=GV%H_to_MKS) endif endif @@ -2537,9 +2515,9 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e ! or enters the ocean with the surface velocity. if (CS%debug) then call MOM_state_chksum("before u/v tridiag ", u, v, h, G, GV, US, haloshift=0) - call hchksum(ea, "before u/v tridiag ea", G%HI, scale=GV%H_to_m) - call hchksum(eb, "before u/v tridiag eb", G%HI, scale=GV%H_to_m) - call hchksum(hold, "before u/v tridiag hold", G%HI, scale=GV%H_to_m) + call hchksum(ea, "before u/v tridiag ea", G%HI, scale=GV%H_to_MKS) + call hchksum(eb, "before u/v tridiag eb", G%HI, scale=GV%H_to_MKS) + call hchksum(hold, "before u/v tridiag hold", G%HI, scale=GV%H_to_MKS) endif call cpu_clock_begin(id_clock_tridiag) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index c103cbc71b..e10e1d5340 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -30,7 +30,7 @@ module MOM_set_visc 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_type -use MOM_verticalGrid, only : verticalGrid_type +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units implicit none ; private @@ -2767,10 +2767,15 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C if (hfreeze >= 0.0 .or. MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) endif + if (hfreeze >= 0.0 .or. MLE_use_PBL_MLD) then + call safe_alloc_ptr(visc%h_ML, isd, ied, jsd, jed) + endif if (MLE_use_PBL_MLD) then call register_restart_field(visc%MLD, "MLD", .false., restart_CS, & "Instantaneous active mixing layer depth", units="m", conversion=US%Z_to_m) + call register_restart_field(visc%h_ML, "h_ML", .false., restart_CS, & + "Instantaneous active mixing layer thickness", units=get_thickness_units(GV), conversion=GV%H_to_mks) endif ! visc%sfc_buoy_flx is used to communicate the state of the (e)PBL or KPP to the rest of the model From d3cb7eea01042abe0fbcc60910c0cd8dbc50a269 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Wed, 24 Apr 2024 09:35:43 -0400 Subject: [PATCH 15/21] +*Use visc%h_ML in tracer diffusion routines Pass visc%h_ML to applyBoundaryFluxesInOut, which avoids the need for the thickness conversions inside of that routine. Answers are bitwise identical for Boussinesq cases, but they will change in non-Boussinesq cases because the layer specific volumes have changed between the time the boundary layer thicknesses have been calculated and when they are being used in the brine plume parameterization. Also use visc%h_ML in place of calls to KPP_get_BLD or energetic_PBL_get_MLD in step_MOM_dyn_split_RK2, hor_bnd_diffusion and neutral_diffusion_calc_coeffs. This change requires a new vertvisc_type argument to tracer_hordiff, hor_bnd_diffusion and neutral_diffusion_calc_coeffs. Boussinesq answers are bitwise identical, but non-Boussinesq answers change because they now use the actual model specific volumes rather than some prescribed constant value to to the relevant unit conversions. The logic in set_visc_register_restarts was also updated so that visc%MLD and visc%h_ML are allocated and registered for restarts in the cases where they will be used. All answers are bitwise identical in Boussinesq mode, but in non-Boussinesq mode there are changes in answers in cases that use neutral tracer diffusion that excludes the boundary layer, horizontal tracer diffusion in the boundary layer or FPMIX. There are also changes to the arguments of several publicly visible routines. --- src/core/MOM.F90 | 8 ++-- src/core/MOM_dynamics_split_RK2.F90 | 9 +---- src/core/MOM_dynamics_split_RK2b.F90 | 9 +---- .../vertical/MOM_CVMix_ddiff.F90 | 4 +- .../vertical/MOM_diabatic_aux.F90 | 39 +++++++------------ .../vertical/MOM_diabatic_driver.F90 | 8 ++-- .../vertical/MOM_set_viscosity.F90 | 29 +++++++++++--- src/tracer/MOM_hor_bnd_diffusion.F90 | 24 ++++++++---- src/tracer/MOM_neutral_diffusion.F90 | 18 ++++++--- src/tracer/MOM_tracer_hor_diff.F90 | 17 ++++---- 10 files changed, 88 insertions(+), 77 deletions(-) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index ad26b10013..e6a42ef7a7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -1433,7 +1433,7 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call advect_tracer(h, CS%uhtr, CS%vhtr, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first) if (CS%debug) call MOM_tracer_chksum("Post-advect ", CS%tracer_Reg, G) - call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(h, CS%t_dyn_rel_adv, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) if (CS%debug) call MOM_tracer_chksum("Post-diffuse ", CS%tracer_Reg, G) if (showCallTree) call callTree_waypoint("finished tracer advection/diffusion (step_MOM)") @@ -1882,7 +1882,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_depth_function(G, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif - call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1909,7 +1909,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS call calc_depth_function(G, CS%VarMix) call calc_slope_functions(CS%h, CS%tv, dt_offline, G, GV, US, CS%VarMix, OBC=CS%OBC) endif - call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(CS%h, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif endif @@ -1966,7 +1966,7 @@ subroutine step_offline(forces, fluxes, sfc_state, Time_start, time_interval, CS CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested if (.not. skip_diffusion) then - call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, G, GV, US, & + call tracer_hordiff(h_end, dt_offline, CS%MEKE, CS%VarMix, CS%visc, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index a184cf473f..b315916ec5 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -71,9 +71,6 @@ module MOM_dynamics_split_RK2 use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units use MOM_wave_interface, only : wave_parameters_CS, Stokes_PGF -use MOM_CVMix_KPP, only : KPP_get_BLD, KPP_CS -use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS -use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member implicit none ; private @@ -139,8 +136,6 @@ module MOM_dynamics_split_RK2 real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: pbce !< pbce times eta gives the baroclinic pressure !! anomaly in each layer due to free surface height !! anomalies [L2 H-1 T-2 ~> m s-2 or m4 kg-1 s-2]. - type(KPP_CS), pointer :: KPP_CSp => NULL() !< KPP control structure needed to ge - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< ePBL control structure real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean !! to the seafloor [R L Z T-2 ~> Pa] @@ -717,9 +712,7 @@ subroutine step_MOM_dyn_split_RK2(u_inst, v_inst, h, tv, visc, Time_local, dt, f if (CS%fpmix) then hbl(:,:) = 0.0 - if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) - if (ASSOCIATED(CS%energetic_PBL_CSp)) & - call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, m_to_MLD_units=GV%m_to_H) + if (associated(visc%h_ML)) hbl(:,:) = visc%h_ML(:,:) call vertFPmix(up, vp, uold, vold, hbl, h, forces, & 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, & diff --git a/src/core/MOM_dynamics_split_RK2b.F90 b/src/core/MOM_dynamics_split_RK2b.F90 index fa78938477..e55e2e3f96 100644 --- a/src/core/MOM_dynamics_split_RK2b.F90 +++ b/src/core/MOM_dynamics_split_RK2b.F90 @@ -73,9 +73,6 @@ module MOM_dynamics_split_RK2b use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units use MOM_wave_interface, only: wave_parameters_CS, Stokes_PGF -use MOM_CVMix_KPP, only : KPP_get_BLD, KPP_CS -use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS -use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member implicit none ; private @@ -147,8 +144,6 @@ module MOM_dynamics_split_RK2b real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_) :: dv_av_inst !< The barotropic meridional velocity increment !! between filtered and instantaneous velocities !! [L T-1 ~> m s-1] - type(KPP_CS), pointer :: KPP_CSp => NULL() !< KPP control structure needed to ge - type(energetic_PBL_CS), pointer :: energetic_PBL_CSp => NULL() !< ePBL control structure real, pointer, dimension(:,:) :: taux_bot => NULL() !< frictional x-bottom stress from the ocean !! to the seafloor [R L Z T-2 ~> Pa] @@ -734,9 +729,7 @@ subroutine step_MOM_dyn_split_RK2b(u_av, v_av, h, tv, visc, Time_local, dt, forc ! if (CS%fpmix) then ! hbl(:,:) = 0.0 - ! if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) - ! if (ASSOCIATED(CS%energetic_PBL_CSp)) & - ! call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, m_to_MLD_units=GV%m_to_H) + ! if (associated(visc%h_ML)) hbl(:,:) = visc%h_ML(:,:) ! call vertFPmix(up, vp, uold, vold, hbl, h, forces, & ! 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, & diff --git a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 index af17e0287f..958b2478f3 100644 --- a/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_ddiff.F90 @@ -245,8 +245,8 @@ subroutine compute_ddiff_coeffs(h, tv, G, GV, US, j, Kd_T, Kd_S, CS, R_rho) iFaceHeight(k+1) = iFaceHeight(k) - dh enddo - ! gets index of the level and interface above hbl - !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, GV%Z_to_H*hbl(i,j)) + ! gets index of the level and interface above hbl in [H ~> m or kg m-2] + !kOBL = CVmix_kpp_compute_kOBL_depth(iFaceHeight, cellHeight, hbl(i,j)) Kd1_T(:) = 0.0 ; Kd1_S(:) = 0.0 call CVMix_coeffs_ddiff(Tdiff_out=Kd1_T(:), & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 1ba5aef392..aa31024b24 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1064,7 +1064,7 @@ end subroutine diagnoseMLDbyEnergy subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, tv, & aggregate_FW_forcing, evap_CFL_limit, & minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, & - SkinBuoyFlux, MLD) + SkinBuoyFlux, MLD_h) type(diabatic_aux_CS), pointer :: CS !< Control structure for diabatic_aux type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -1094,7 +1094,8 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !! salinity [R-1 S-1 ~> m3 kg-1 ppt-1]. real, dimension(SZI_(G),SZJ_(G)), & optional, intent(out) :: SkinBuoyFlux !< Buoyancy flux at surface [Z2 T-3 ~> m2 s-3]. - real, pointer, dimension(:,:), optional :: MLD !< Mixed layer depth for brine plumes [Z ~> m] + real, dimension(:,:), & + optional, pointer :: MLD_h !< Mixed layer thickness for brine plumes [H ~> m or kg m-2] ! Local variables integer, parameter :: maxGroundings = 5 @@ -1137,8 +1138,6 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! [S H T-1 ~> ppt m s-1 or ppt kg m-2 s-1] netMassInOut_rate, & ! netmassinout but for dt=1 [H T-1 ~> m s-1 or kg m-2 s-1] mixing_depth, & ! The mixing depth for brine plumes [H ~> m or kg m-2] - MLD_H, & ! The mixed layer depth for brine plumes in thickness units [H ~> m or kg m-2] - MLD_Z, & ! Running sum of distance from the surface for finding MLD_H [Z ~> m] total_h ! Total thickness of the water column [H ~> m or kg m-2] real, dimension(SZI_(G), SZK_(GV)) :: & h2d, & ! A 2-d copy of the thicknesses [H ~> m or kg m-2] @@ -1204,11 +1203,15 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t GoRho = US%L_to_Z**2*GV%g_Earth / GV%Rho0 endif - if (CS%do_brine_plume .and. .not. associated(MLD)) then + if (CS%do_brine_plume .and. .not.present(MLD_h)) then call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& - "Brine plume parameterization requires a mixed-layer depth,\n"//& + "Brine plume parameterization requires a mixed-layer depth argument,\n"//& "currently coming from the energetic PBL scheme.") endif + if (CS%do_brine_plume .and. .not.associated(MLD_h)) then + call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& + "Brine plume parameterization requires an associated mixed-layer depth.") + endif if (CS%do_brine_plume .and. .not. associated(fluxes%salt_left_behind)) then call MOM_error(FATAL, "MOM_diabatic_aux.F90, applyBoundaryFluxesInOut(): "//& "Brine plume parameterization requires DO_BRINE_PLUME\n"//& @@ -1232,7 +1235,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP minimum_forcing_depth,evap_CFL_limit,dt,EOSdom, & !$OMP calculate_buoyancy,netPen_rate,SkinBuoyFlux,GoRho,& !$OMP calculate_energetics,dSV_dT,dSV_dS,cTKE,g_Hconv2, & - !$OMP EnthalpyConst,MLD) & + !$OMP EnthalpyConst,MLD_h) & !$OMP private(opacityBand,h2d,T2d,netMassInOut,netMassOut, & !$OMP netHeat,netSalt,Pen_SW_bnd,fractionOfForcing, & !$OMP IforcingDepthScale,g_conv,dSpV_dT,dSpV_dS, & @@ -1242,7 +1245,7 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t !$OMP drhodt,drhods,pen_sw_bnd_rate, & !$OMP pen_TKE_2d,Temp_in,Salin_in,RivermixConst, & !$OMP mixing_depth,A_brine,fraction_left_brine, & - !$OMP plume_fraction,dK,MLD_H,MLD_Z,total_h) & + !$OMP plume_fraction,dK,total_h) & !$OMP firstprivate(SurfPressure,plume_flux) do j=js,je ! Work in vertical slices for efficiency @@ -1368,24 +1371,10 @@ subroutine applyBoundaryFluxesInOut(CS, G, GV, US, dt, fluxes, optics, nsw, h, t ! C/ update temp due to penetrative SW if (CS%do_brine_plume) then ! Find the plume mixing depth. - if (GV%Boussinesq .or. .not.allocated(tv%SpV_avg)) then - do i=is,ie ; MLD_H(i) = GV%Z_to_H * MLD(i,j) ; total_h(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie ; total_h(i) = total_h(i) + h(i,j,k) ; enddo ; enddo - else - do i=is,ie ; MLD_H(i) = 0.0 ; MLD_Z(i) = 0.0 ; total_h(i) = 0.0 ; enddo - do k=1,nz ; do i=is,ie - total_h(i) = total_h(i) + h(i,j,k) - if (MLD_Z(i) + GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) < MLD(i,j)) then - MLD_H(i) = MLD_H(i) + h(i,j,k) - MLD_Z(i) = MLD_Z(i) + GV%H_to_RZ * h(i,j,k) * tv%SpV_avg(i,j,k) - elseif (MLD_Z(i) < MLD(i,j)) then ! This is the last layer in the mixed layer - MLD_H(i) = MLD_H(i) + GV%RZ_to_H * (MLD(i,j) - MLD_Z(i)) / tv%SpV_avg(i,j,k) - MLD_Z(i) = MLD(i,j) - endif - enddo ; enddo - endif + do i=is,ie ; total_h(i) = 0.0 ; enddo + do k=1,nz ; do i=is,ie ; total_h(i) = total_h(i) + h(i,j,k) ; enddo ; enddo do i=is,ie - mixing_depth(i) = min( max(MLD_H(i) - minimum_forcing_depth, minimum_forcing_depth), & + mixing_depth(i) = min( max(MLD_h(i,j) - minimum_forcing_depth, minimum_forcing_depth), & max(total_h(i), GV%angstrom_h) ) + GV%H_subroundoff A_brine(i) = (CS%brine_plume_n + 1) / (mixing_depth(i) ** (CS%brine_plume_n + 1)) enddo diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 4f4c605a11..f2446e0332 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -825,7 +825,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD) + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD_h=visc%h_ML) if (CS%debug) then call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_mks) @@ -885,7 +885,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD) + CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD_h=visc%h_ML) ! Find the vertical distances across layers, which may have been modified by the net surface flux call thickness_to_dz(h, tv, dz, G, GV, US) @@ -1377,7 +1377,7 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, skinbuoyflux(:,:) = 0.0 call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, CS%evap_CFL_limit, & - CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD=visc%MLD) + CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS, SkinBuoyFlux=SkinBuoyFlux, MLD_h=visc%h_ML) if (CS%debug) then call hchksum(ent_t, "after applyBoundaryFluxes ent_t", G%HI, haloshift=0, scale=GV%H_to_MKS) @@ -1423,7 +1423,7 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, else call applyBoundaryFluxesInOut(CS%diabatic_aux_CSp, G, GV, US, dt, fluxes, CS%optics, & optics_nbands(CS%optics), h, tv, CS%aggregate_FW_forcing, & - CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD=visc%MLD) + CS%evap_CFL_limit, CS%minimum_forcing_depth, MLD_h=visc%h_ML) endif ! endif for CS%use_energetic_PBL diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index e10e1d5340..ab92a60950 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2694,6 +2694,7 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C ! Local variables logical :: use_kappa_shear, KS_at_vertex logical :: adiabatic, useKPP, useEPBL + logical :: do_brine_plume, use_hor_bnd_diff, use_neutral_diffusion, use_fpmix logical :: use_CVMix_shear, MLE_use_PBL_MLD, MLE_use_Bodner, use_CVMix_conv integer :: isd, ied, jsd, jed, nz real :: hfreeze !< If hfreeze > 0 [Z ~> m], melt potential will be computed. @@ -2757,25 +2758,43 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C call safe_alloc_ptr(visc%Kv_slow, isd, ied, jsd, jed, nz+1) endif - ! visc%MLD is used to communicate the state of the (e)PBL or KPP to the rest of the model + ! visc%MLD and visc%h_ML are used to communicate the state of the (e)PBL or KPP to the rest of the model call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) - ! visc%MLD needs to be allocated when melt potential is computed (HFREEZE>0) + ! visc%h_ML needs to be allocated when melt potential is computed (HFREEZE>0) or one of + ! several other parameterizations are in use. call get_param(param_file, mdl, "HFREEZE", hfreeze, & units="m", default=-1.0, scale=US%m_to_Z, do_not_log=.true.) + call get_param(param_file, mdl, "DO_BRINE_PLUME", do_brine_plume, & + "If true, use a brine plume parameterization from Nguyen et al., 2009.", & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_HORIZONTAL_BOUNDARY_DIFFUSION", use_hor_bnd_diff, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_NEUTRAL_DIFFUSION", use_neutral_diffusion, & + default=.false., do_not_log=.true.) + if (use_neutral_diffusion) & + call get_param(param_file, mdl, "NDIFF_INTERIOR_ONLY", use_neutral_diffusion, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "FPMIX", use_fpmix, & + default=.false., do_not_log=.true.) - if (hfreeze >= 0.0 .or. MLE_use_PBL_MLD) then + if (MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) endif - if (hfreeze >= 0.0 .or. MLE_use_PBL_MLD) then + if ((hfreeze >= 0.0) .or. MLE_use_PBL_MLD .or. do_brine_plume .or. use_fpmix .or. & + use_neutral_diffusion .or. use_hor_bnd_diff) then call safe_alloc_ptr(visc%h_ML, isd, ied, jsd, jed) endif if (MLE_use_PBL_MLD) then call register_restart_field(visc%MLD, "MLD", .false., restart_CS, & "Instantaneous active mixing layer depth", units="m", conversion=US%Z_to_m) + endif + if (MLE_use_PBL_MLD .or. do_brine_plume .or. use_fpmix .or. & + use_neutral_diffusion .or. use_hor_bnd_diff) then call register_restart_field(visc%h_ML, "h_ML", .false., restart_CS, & - "Instantaneous active mixing layer thickness", units=get_thickness_units(GV), conversion=GV%H_to_mks) + "Instantaneous active mixing layer thickness", & + units=get_thickness_units(GV), conversion=GV%H_to_mks) endif ! visc%sfc_buoy_flx is used to communicate the state of the (e)PBL or KPP to the rest of the model diff --git a/src/tracer/MOM_hor_bnd_diffusion.F90 b/src/tracer/MOM_hor_bnd_diffusion.F90 index 163d8a480f..13e91e8973 100644 --- a/src/tracer/MOM_hor_bnd_diffusion.F90 +++ b/src/tracer/MOM_hor_bnd_diffusion.F90 @@ -20,6 +20,7 @@ module MOM_hor_bnd_diffusion use MOM_spatial_means, only : global_mass_integral use MOM_tracer_registry, only : tracer_registry_type, tracer_type use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use MOM_CVMix_KPP, only : KPP_get_BLD, KPP_CS use MOM_energetic_PBL, only : energetic_PBL_get_MLD, energetic_PBL_CS @@ -161,7 +162,7 @@ end function hor_bnd_diffusion_init !! 2) calculate diffusive tracer fluxes (F) in the HBD grid using a layer by layer approach !! 3) remap fluxes to the native grid !! 4) update tracer by adding the divergence of F -subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) +subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, visc, CS) type(ocean_grid_type), intent(inout) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -171,6 +172,8 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) real, intent(in) :: dt !< Tracer time step * I_numitts !! (I_numitts in tracer_hordiff) [T ~> s] type(tracer_registry_type), pointer :: Reg !< Tracer registry + type(vertvisc_type), intent(in) :: visc !< Structure with vertical viscosities, + !! boundary layer properties and related fields type(hbd_CS), pointer :: CS !< Control structure for this module ! Local variables @@ -203,10 +206,14 @@ subroutine hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, dt, Reg, CS) call cpu_clock_begin(id_clock_hbd) Idt = 1./dt - if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, hbl, G, US, m_to_BLD_units=GV%m_to_H) - if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, hbl, G, US, & - m_to_MLD_units=GV%m_to_H) - call pass_var(hbl,G%Domain) + + if (associated(visc%h_ML)) then + hbl(:,:) = visc%h_ML(:,:) + else + call MOM_error(FATAL, "hor_bnd_diffusion requires that visc%h_ML is associated.") + endif + ! This halo update is probably not necessary because visc%h_ML has valid halo data. + call pass_var(hbl, G%Domain, halo=1) ! build HBD grid call hbd_grid(SURFACE, G, GV, hbl, h, CS) @@ -336,10 +343,11 @@ subroutine hbd_grid(boundary, G, GV, hbl, h, CS) integer, intent(in ) :: boundary !< Which boundary layer SURFACE or BOTTOM [nondim] type(ocean_grid_type), intent(inout) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G)) :: hbl !< Boundary layer depth [H ~> m or kg m-2] + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: hbl !< Boundary layer depth [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & - intent(in) :: h !< Layer thickness in the native grid [H ~> m or kg m-2] - type(hbd_CS), pointer :: CS !< Horizontal diffusion control structure + intent(in) :: h !< Layer thickness in the native grid [H ~> m or kg m-2] + type(hbd_CS), pointer :: CS !< Horizontal diffusion control structure ! Local variables real, allocatable :: dz_top(:) !< temporary HBD grid given by merge_interfaces [H ~> m or kg m-2] diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 094825d031..402a008244 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -20,6 +20,7 @@ module MOM_neutral_diffusion use MOM_remapping, only : average_value_ppoly, remappingSchemesDoc, remappingDefaultScheme use MOM_tracer_registry, only : tracer_registry_type, tracer_type use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : vertvisc_type use MOM_verticalGrid, only : verticalGrid_type use polynomial_functions, only : evaluation_polynomial, first_derivative_polynomial use PPM_functions, only : PPM_reconstruction, PPM_boundary_extrapolation @@ -142,7 +143,7 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, type(diag_ctrl), target, intent(inout) :: diag !< Diagnostics control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), target, intent(in) :: EOS !< Equation of state - type(diabatic_CS), pointer :: diabatic_CSp!< KPP control structure needed to get BLD + type(diabatic_CS), pointer :: diabatic_CSp!< diabatic control structure needed to get BLD type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure ! Local variables @@ -333,13 +334,15 @@ end function neutral_diffusion_init !> Calculate remapping factors for u/v columns used to map adjoining columns to !! a shared coordinate space. -subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) +subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, visc, CS, p_surf) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thickness [H ~> m or kg m-2] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: T !< Potential temperature [C ~> degC] real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: S !< Salinity [S ~> ppt] + type(vertvisc_type), intent(in) :: visc !< Structure with vertical viscosities, + !! boundary layer properties and related fields type(neutral_diffusion_CS), pointer :: CS !< Neutral diffusion control structure real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: p_surf !< Surface pressure to include in pressures used !! for equation of state calculations [R L2 T-2 ~> Pa] @@ -369,10 +372,13 @@ subroutine neutral_diffusion_calc_coeffs(G, GV, US, h, T, S, CS, p_surf) ! Check if hbl needs to be extracted if (CS%interior_only) then - if (ASSOCIATED(CS%KPP_CSp)) call KPP_get_BLD(CS%KPP_CSp, CS%hbl, G, US, m_to_BLD_units=GV%m_to_H) - if (ASSOCIATED(CS%energetic_PBL_CSp)) call energetic_PBL_get_MLD(CS%energetic_PBL_CSp, CS%hbl, G, US, & - m_to_MLD_units=GV%m_to_H) - call pass_var(CS%hbl,G%Domain) + if (associated(visc%h_ML)) then + CS%hbl(:,:) = visc%h_ML(:,:) + else + call MOM_error(FATAL, "hor_bnd_diffusion requires that visc%h_ML is associated.") + endif + call pass_var(CS%hbl, G%Domain, halo=1) + ! get k-indices and zeta do j=G%jsc-1, G%jec+1 ; do i=G%isc-1,G%iec+1 if (G%mask2dT(i,j) > 0.0) then diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 732a42e44b..2b1530e94d 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -27,7 +27,7 @@ module MOM_tracer_hor_diff use MOM_hor_bnd_diffusion, only : hor_bnd_diffusion, hor_bnd_diffusion_end use MOM_tracer_registry, only : tracer_registry_type, tracer_type, MOM_tracer_chksum use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : thermo_var_ptrs +use MOM_variables, only : thermo_var_ptrs, vertvisc_type use MOM_verticalGrid, only : verticalGrid_type implicit none ; private @@ -113,7 +113,7 @@ module MOM_tracer_hor_diff !! using the diffusivity in CS%KhTr, or using space-dependent diffusivity. !! Multiple iterations are used (if necessary) so that there is no limit !! on the acceptable time increment. -subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) +subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_online_flag, read_khdt_x, read_khdt_y) type(ocean_grid_type), intent(inout) :: G !< Grid type type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -121,6 +121,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online real, intent(in) :: dt !< time step [T ~> s] type(MEKE_type), intent(in) :: MEKE !< MEKE fields type(VarMix_CS), intent(in) :: VarMix !< Variable mixing type + type(vertvisc_type), intent(in) :: visc !< Structure with vertical viscosities, + !! boundary layer properties and related fields type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(tracer_hor_diff_CS), pointer :: CS !< module control structure type(tracer_registry_type), pointer :: Reg !< registered tracers @@ -442,7 +444,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online if (itt>1) then ! Update halos for subsequent iterations call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) endif - call hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, I_numitts*dt, Reg, & + call hor_bnd_diffusion(G, GV, US, h, Coef_x, Coef_y, I_numitts*dt, Reg, visc, & CS%hor_bnd_diffusion_CSp) enddo ! itt endif @@ -457,9 +459,9 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online ! would be inside the itt-loop. -AJA if (associated(tv%p_surf)) then - call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, CS%neutral_diffusion_CSp, p_surf=tv%p_surf) + call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, visc, CS%neutral_diffusion_CSp, p_surf=tv%p_surf) else - call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, CS%neutral_diffusion_CSp) + call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, visc, CS%neutral_diffusion_CSp) endif do k=1,nz+1 @@ -499,9 +501,10 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, US, CS, Reg, tv, do_online call do_group_pass(CS%pass_t, G%Domain, clock=id_clock_pass) if (CS%recalc_neutral_surf) then if (associated(tv%p_surf)) then - call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, CS%neutral_diffusion_CSp, p_surf=tv%p_surf) + call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, visc, CS%neutral_diffusion_CSp, & + p_surf=tv%p_surf) else - call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, CS%neutral_diffusion_CSp) + call neutral_diffusion_calc_coeffs(G, GV, US, h, tv%T, tv%S, visc, CS%neutral_diffusion_CSp) endif endif endif From d66adffb53846016ec4793537e6bdc1998002ba9 Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Thu, 25 Apr 2024 16:49:44 -0400 Subject: [PATCH 16/21] +*Pass visc%h_ML to call_tracer_column_fns Added the optional argument h_BL to call_tracer_column_fns, and then pass visc%h_ML to this routine as a part of the calls from the diabatic routines. This argument is not provided in adiabatic mode or in offline tracer mode, which is why it has been made optional. All answers are bitwise identical in Boussinesq mode but ideal age tracers can change in non-Boussinesq mode due to the updates to the layer specific volumes between the calculation of the boundary layer properties and the calls to call_tracer_column_fns. --- .../vertical/MOM_diabatic_driver.F90 | 13 +++++-------- .../vertical/MOM_set_viscosity.F90 | 6 ++++-- src/tracer/MOM_tracer_flow_control.F90 | 18 +++++++++++++++--- 3 files changed, 24 insertions(+), 13 deletions(-) diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index f2446e0332..b450127156 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -1073,7 +1073,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & - minimum_forcing_depth=CS%minimum_forcing_depth) + minimum_forcing_depth=CS%minimum_forcing_depth, h_BL=visc%h_ML) call cpu_clock_end(id_clock_tracers) @@ -1587,7 +1587,7 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, KPP_CSp=CS%KPP_CSp, & nonLocalTrans=KPP_NLTscalar, & evap_CFL_limit=CS%evap_CFL_limit, & - minimum_forcing_depth=CS%minimum_forcing_depth) + minimum_forcing_depth=CS%minimum_forcing_depth, h_BL=visc%h_ML) call cpu_clock_end(id_clock_tracers) @@ -2381,8 +2381,7 @@ subroutine layered_diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_e call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & - KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=KPP_NLTscalar) + KPP_CSp=CS%KPP_CSp, nonLocalTrans=KPP_NLTscalar, h_BL=visc%h_ML) elseif (CS%double_diffuse) then ! extra diffusivity for passive tracers @@ -2403,14 +2402,12 @@ subroutine layered_diabatic(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_e call call_tracer_column_fns(hold, h, eatr, ebtr, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & - KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=KPP_NLTscalar) + KPP_CSp=CS%KPP_CSp, nonLocalTrans=KPP_NLTscalar, h_BL=visc%h_ML) else call call_tracer_column_fns(hold, h, ea, eb, fluxes, BLD, dt, G, GV, US, tv, & CS%optics, CS%tracer_flow_CSp, CS%debug, & - KPP_CSp=CS%KPP_CSp, & - nonLocalTrans=KPP_NLTscalar) + KPP_CSp=CS%KPP_CSp, nonLocalTrans=KPP_NLTscalar, h_BL=visc%h_ML) endif ! (CS%mix_boundary_tracers) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index ab92a60950..e59e5d99aa 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2693,7 +2693,7 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C logical, intent(in) :: use_ice_shelf !< if true, register tau_shelf restarts ! Local variables logical :: use_kappa_shear, KS_at_vertex - logical :: adiabatic, useKPP, useEPBL + logical :: adiabatic, useKPP, useEPBL, use_ideal_age logical :: do_brine_plume, use_hor_bnd_diff, use_neutral_diffusion, use_fpmix logical :: use_CVMix_shear, MLE_use_PBL_MLD, MLE_use_Bodner, use_CVMix_conv integer :: isd, ied, jsd, jed, nz @@ -2777,12 +2777,14 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C default=.false., do_not_log=.true.) call get_param(param_file, mdl, "FPMIX", use_fpmix, & default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", use_ideal_age, & + default=.false., do_not_log=.true.) if (MLE_use_PBL_MLD) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) endif if ((hfreeze >= 0.0) .or. MLE_use_PBL_MLD .or. do_brine_plume .or. use_fpmix .or. & - use_neutral_diffusion .or. use_hor_bnd_diff) then + use_neutral_diffusion .or. use_hor_bnd_diff .or. use_ideal_age) then call safe_alloc_ptr(visc%h_ML, isd, ied, jsd, jed) endif diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index 10aba675da..ca85fc234f 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -429,7 +429,7 @@ end subroutine call_tracer_set_forcing !> This subroutine calls all registered tracer column physics subroutines. subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, US, tv, optics, CS, & - debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) + debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth, h_BL) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_old !< Layer thickness before entrainment @@ -464,9 +464,11 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, !! of the top layer in a timestep [nondim] real, optional, intent(in) :: minimum_forcing_depth !< The smallest depth over !! which fluxes can be applied [H ~> m or kg m-2] + real, dimension(:,:), optional, pointer :: h_BL !< Thickness of active mixing layer [H ~> m or kg m-2] ! Local variables real :: Hbl(SZI_(G),SZJ_(G)) !< Boundary layer thickness [H ~> m or kg m-2] + logical :: use_h_BL if (.not. associated(CS)) call MOM_error(FATAL, "call_tracer_column_fns: "// & "Module must be initialized via call_tracer_register before it is used.") @@ -493,7 +495,12 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) if (CS%use_ideal_age) then - call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) + use_h_BL = .false. ; if (present(h_BL)) use_h_BL = associated(h_BL) + if (present(h_BL)) then + Hbl(:,:) = h_BL(:,:) + else ! This option is here mostly to support the offline tracers. + call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) + endif call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%ideal_age_tracer_CSp, & evap_CFL_limit=evap_CFL_limit, & @@ -573,7 +580,12 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, call RGC_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%RGC_tracer_CSp) if (CS%use_ideal_age) then - call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) + use_h_BL = .false. ; if (present(h_BL)) use_h_BL = associated(h_BL) + if (present(h_BL)) then + Hbl(:,:) = h_BL(:,:) + else ! This option is here mostly to support the offline tracers. + call convert_MLD_to_ML_thickness(mld, h_new, Hbl, tv, G, GV) + endif call ideal_age_tracer_column_physics(h_old, h_new, ea, eb, fluxes, dt, & G, GV, US, CS%ideal_age_tracer_CSp, Hbl=Hbl) endif From 70bfe8f0c48b22857db358f3033215ce5f0603a2 Mon Sep 17 00:00:00 2001 From: Kate Hedstrom Date: Sun, 2 Jun 2024 01:55:12 -0800 Subject: [PATCH 17/21] Spatially variable fields for MLE%Bodner (#617) * Spatially variable fields for MLE%Bodner - Allows reading in 2d fields for Cr and for MLD_decaying_Tfilt. * Finish the job? * Renamed one variable, fixed some units --- .../lateral/MOM_mixed_layer_restrat.F90 | 61 ++++++++++++++++--- 1 file changed, 52 insertions(+), 9 deletions(-) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index e7ada31430..9f0061f104 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -15,6 +15,7 @@ module MOM_mixed_layer_restrat use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_intrinsic_functions, only : cuberoot +use MOM_io, only : MOM_read_data use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_unit_scaling, only : unit_scale_type @@ -98,11 +99,15 @@ module MOM_mixed_layer_restrat real :: Kv_restrat !< A viscosity that sets a floor on the momentum mixing rate !! during restratification, rescaled into thickness-based !! units [H2 T-1 ~> m2 s-1 or kg2 m-4 s-1] + logical :: MLD_grid !< If true, read a spacially varying field for MLD_decaying_Tfilt + logical :: Cr_grid !< If true, read a spacially varying field for Cr real, dimension(:,:), allocatable :: & MLD_filtered, & !< Time-filtered MLD [H ~> m or kg m-2] MLD_filtered_slow, & !< Slower time-filtered MLD [H ~> m or kg m-2] - wpup_filtered !< Time-filtered vertical momentum flux [H L T-2 ~> m2 s-2 or kg m-1 s-2] + wpup_filtered, & !< Time-filtered vertical momentum flux [H L T-2 ~> m2 s-2 or kg m-1 s-2] + MLD_Tfilt_space, & !< Spatially varying time scale for MLD filter [T ~> s] + Cr_space !< Spatially varying Cr coefficient [nondim] !>@{ !! Diagnostic identifier @@ -887,11 +892,19 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d enddo ; enddo ! Calculate "big H", representative of the mixed layer depth, used in B22 formula (eq 27). - do j=js-1,je+1 ; do i=is-1,ie+1 - big_H(i,j) = rmean2ts(little_h(i,j), CS%MLD_filtered_slow(i,j), & - CS%MLD_growing_Tfilt, CS%MLD_decaying_Tfilt, dt) - CS%MLD_filtered_slow(i,j) = big_H(i,j) - enddo ; enddo + if (CS%MLD_grid) then + do j=js-1,je+1 ; do i=is-1,ie+1 + big_H(i,j) = rmean2ts(little_h(i,j), CS%MLD_filtered_slow(i,j), & + CS%MLD_growing_Tfilt, CS%MLD_Tfilt_space(i,j), dt) + CS%MLD_filtered_slow(i,j) = big_H(i,j) + enddo ; enddo + else + do j=js-1,je+1 ; do i=is-1,ie+1 + big_H(i,j) = rmean2ts(little_h(i,j), CS%MLD_filtered_slow(i,j), & + CS%MLD_growing_Tfilt, CS%MLD_decaying_Tfilt, dt) + CS%MLD_filtered_slow(i,j) = big_H(i,j) + enddo ; enddo + endif ! Estimate w'u' at h-points, with a floor to avoid division by zero later. if (allocated(tv%SpV_avg) .and. .not.(GV%Boussinesq .or. GV%semi_Boussinesq)) then @@ -1050,7 +1063,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d h_big = 0.5*( big_H(i,j) + big_H(i+1,j) ) ! H ~> m or kg m-3 grd_b = ( buoy_av(i+1,j) - buoy_av(i,j) ) * G%IdxCu(I,j) ! L H-1 T-2 ~> s-2 or m3 kg-1 s-2 r_wpup = 2. / ( wpup(i,j) + wpup(i+1,j) ) ! T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1 - psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 + psi_mag = ( ( ( CS%Cr_space(i,j) * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 * ( ( h_big**2 ) * grd_b ) ) * r_wpup else ! There is no flux on land and no gradient at open boundary points. psi_mag = 0.0 @@ -1091,7 +1104,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d h_big = 0.5*( big_H(i,j) + big_H(i,j+1) ) ! H ~> m or kg m-3 grd_b = ( buoy_av(i,j+1) - buoy_av(i,j) ) * G%IdyCv(I,j) ! L H-1 T-2 ~> s-2 or m3 kg-1 s-2 r_wpup = 2. / ( wpup(i,j) + wpup(i,j+1) ) ! T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1 - psi_mag = ( ( ( CS%Cr * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 + psi_mag = ( ( ( CS%Cr_space(i,j) * grid_dsd ) * ( absf * h_sml ) ) & ! L2 H T-1 ~> m3 s-1 or kg s-1 * ( ( h_big**2 ) * grd_b ) ) * r_wpup else ! There is no flux on land and no gradient at open boundary points. psi_mag = 0.0 @@ -1549,6 +1562,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, ! This include declares and sets the variable "version". # include "version_variable.h" integer :: i, j + character(len=200) :: filename, inputdir, varname ! Read all relevant parameters and write them to the model log. call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & @@ -1571,11 +1585,14 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, CS%MLE_MLD_stretch = -9.e9 CS%use_Stanley_ML = .false. CS%use_Bodner = .false. + CS%MLD_grid = .false. + CS%Cr_grid = .false. call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) 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, do_not_log=.true.) + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") call openParameterBlock(param_file,'MLE') ! Prepend MLE% to all parameters if (GV%nkml==0) then call get_param(param_file, mdl, "USE_BODNER23", CS%use_Bodner, & @@ -1584,7 +1601,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, default=.false.) endif if (CS%use_Bodner) then - call get_param(param_file, mdl, "CR", CS%CR, & + call get_param(param_file, mdl, "CR", CS%Cr, & "The efficiency coefficient in eq 27 of Bodner et al., 2023.", & units="nondim", default=0.0) call get_param(param_file, mdl, "BODNER_NSTAR", CS%Nstar, & @@ -1638,6 +1655,32 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, call get_param(param_file, mdl, "USE_STANLEY_TVAR", 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, "USE_CR_GRID", CS%Cr_grid, & + "If true, read in a spatially varying Cr field.", default=.false.) + call get_param(param_file, mdl, "USE_MLD_GRID", CS%MLD_grid, & + "If true, read in a spatially varying MLD_decaying_Tfilt field.", default=.false.) + if (CS%MLD_grid) then + call get_param(param_file, mdl, "MLD_TFILT_FILE", filename, & + "The path to the file containing the MLD_decaying_Tfilt fields.", & + default="") + call get_param(param_file, mdl, "MLD_TFILT_VAR", varname, & + "The variable name for MLD_decaying_Tfilt field.", & + default="MLD_tfilt") + filename = trim(inputdir) // "/" // trim(filename) + allocate(CS%MLD_Tfilt_space(G%isd:G%ied,G%jsd:G%jed), source=0.0) + call MOM_read_data(filename, varname, CS%MLD_Tfilt_space, G%domain, scale=US%s_to_T) + endif + allocate(CS%Cr_space(G%isd:G%ied,G%jsd:G%jed), source=CS%Cr) + if (CS%Cr_grid) then + call get_param(param_file, mdl, "CR_FILE", filename, & + "The path to the file containing the Cr fields.", & + default="") + call get_param(param_file, mdl, "CR_VAR", varname, & + "The variable name for Cr field.", & + default="Cr") + filename = trim(inputdir) // "/" // trim(filename) + call MOM_read_data(filename, varname, CS%Cr_space, G%domain) + endif call closeParameterBlock(param_file) ! The remaining parameters do not have MLE% prepended call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer "//& From b61022604a5ddde96be872cb6ec0d7ae9c58243b Mon Sep 17 00:00:00 2001 From: Alex Huth Date: Sun, 2 Jun 2024 17:31:16 -0400 Subject: [PATCH 18/21] Flux through static ice-shelf to icebergs/new diagnostics (#622) * Added option to convert flux through static ice front into icebergs Added variables for the accumulated iceberg mass and heat flux due to calving from ice shelves (flux through the static ice front). These will be passed to the coupler and SIS2/iceberg module to initialize bergs. Also fixed the ice-shelf SMB override and reorganized ice-shelf post data calls so that they do not strictly have to be called at multiples of the ice velocity time step. * Added ice-shelf scalar diagnostics Added ice-shelf scalar diagnostics related to volume-above-floatation and surface/basal mass balance. Had to modify ice-shelf diag mediator to allow scalar diagnostics. * Fixed units for volume-above-floatation and Cp_ice. Renamed volume-above-floatation variable from 'vab' to 'vaf' * Fixed write_ice_shelf_energy call within subroutine solo_step_ice_shelf so that it is passing the correct arguments * Fixed syntax of calving units * Fixed units for ice shelf calving and scalar diagnostics --- .../drivers/FMS_cap/ocean_model_MOM.F90 | 47 ++- src/core/MOM.F90 | 15 +- src/ice_shelf/MOM_ice_shelf.F90 | 286 ++++++++++++++++-- src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 | 113 ++++++- src/ice_shelf/MOM_ice_shelf_dynamics.F90 | 125 ++++++-- src/ice_shelf/MOM_ice_shelf_state.F90 | 10 +- 6 files changed, 541 insertions(+), 55 deletions(-) diff --git a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 index 18bb0dbd06..45c14e73eb 100644 --- a/config_src/drivers/FMS_cap/ocean_model_MOM.F90 +++ b/config_src/drivers/FMS_cap/ocean_model_MOM.F90 @@ -55,6 +55,7 @@ module ocean_model_mod 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_ice_shelf, only : ice_sheet_calving_to_ocean_sfc use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init use MOM_wave_interface, only: Update_Surface_Waves use iso_fortran_env, only : int64 @@ -121,7 +122,10 @@ module ocean_model_mod !! formation in the ocean. melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice [J m-2]. OBLD => NULL(), & !< Ocean boundary layer depth [m]. - area => NULL() !< cell area of the ocean surface [m2]. + area => NULL(), & !< cell area of the ocean surface [m2]. + calving => NULL(), &!< The mass per unit area of the ice shelf to convert to + !! bergs [kg m-2]. + calving_hflx => NULL() !< Calving heat flux [W m-2]. type(coupler_2d_bc_type) :: fields !< A structure that may contain named !! arrays of tracer-related surface fields. integer :: avg_kount !< A count of contributions to running @@ -157,6 +161,8 @@ module ocean_model_mod !! ocean dynamics and forcing fluxes. real :: press_to_z !< A conversion factor between pressure and ocean depth, !! usually 1/(rho_0*g) [Z T2 R-1 L-2 ~> m Pa-1]. + logical :: calve_ice_shelf_bergs = .false. !< If true, bergs are initialized according to + !! ice shelf flux through the ice front real :: C_p !< The heat capacity of seawater [J degC-1 kg-1]. logical :: offline_tracer_mode = .false. !< If false, use the model in prognostic mode !! with the barotropic and baroclinic dynamics, thermodynamics, @@ -221,7 +227,7 @@ module ocean_model_mod !! This subroutine initializes both the ocean state and the ocean surface type. !! Because of the way that indices and domains are handled, Ocean_sfc must have !! been used in a previous call to initialize_ocean_type. -subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas_fields_ocn) +subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas_fields_ocn, calve_ice_shelf_bergs) type(ocean_public_type), target, & intent(inout) :: Ocean_sfc !< A structure containing various publicly !! visible ocean surface properties after initialization, @@ -239,6 +245,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas !! in the calculation of additional gas or other !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. + logical, optional, intent(in) :: calve_ice_shelf_bergs !< If true, track ice shelf flux through a + !! static ice shelf, so that it can be converted into icebergs ! Local variables real :: Rho0 ! The Boussinesq ocean density [R ~> kg m-3] real :: G_Earth ! The gravitational acceleration [L2 Z-1 T-2 ~> m s-2] @@ -247,6 +255,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas !! min(HFrz, OBLD), where OBLD is the boundary layer depth. !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot !< If true, allocate melt_potential array + logical :: point_calving ! Equals calve_ice_shelf_bergs if calve_ice_shelf_bergs is present ! This include declares and sets the variable "version". # include "version_variable.h" @@ -274,11 +283,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas 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. - + point_calving=.false.; if (present(calve_ice_shelf_bergs)) point_calving=calve_ice_shelf_bergs call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & Time_in, offline_tracer_mode=OS%offline_tracer_mode, & diag_ptr=OS%diag, count_calls=.true., ice_shelf_CSp=OS%ice_shelf_CSp, & - waves_CSp=OS%Waves) + waves_CSp=OS%Waves, calve_ice_shelf_bergs=point_calving) 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) @@ -406,6 +415,13 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, wind_stagger, gas endif + if (present(calve_ice_shelf_bergs)) then + if (calve_ice_shelf_bergs) then + call convert_shelf_state_to_ocean_type(Ocean_sfc, OS%Ice_shelf_CSp, OS%US) + OS%calve_ice_shelf_bergs=.true. + endif + endif + call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -668,6 +684,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, time_start_upda ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US, & ! OS%fluxes%p_surf_full, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, OS%US) + if (OS%calve_ice_shelf_bergs) call convert_shelf_state_to_ocean_type(Ocean_sfc,OS%Ice_shelf_CSp, OS%US) Time1 = OS%Time ; if (do_dyn) Time1 = OS%Time_dyn call coupler_type_send_data(Ocean_sfc%fields, Time1) @@ -789,6 +806,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_field Ocean_sfc%u_surf (isc:iec,jsc:jec), & Ocean_sfc%v_surf (isc:iec,jsc:jec), & Ocean_sfc%sea_lev(isc:iec,jsc:jec), & + Ocean_sfc%calving(isc:iec,jsc:jec), & + Ocean_sfc%calving_hflx(isc:iec,jsc:jec), & Ocean_sfc%area (isc:iec,jsc:jec), & Ocean_sfc%melt_potential(isc:iec,jsc:jec), & Ocean_sfc%OBLD (isc:iec,jsc:jec), & @@ -799,6 +818,8 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, gas_field Ocean_sfc%u_surf(:,:) = 0.0 ! time averaged u-current (m/sec) passed to atmosphere/ice models Ocean_sfc%v_surf(:,:) = 0.0 ! time averaged v-current (m/sec) passed to atmosphere/ice models Ocean_sfc%sea_lev(:,:) = 0.0 ! time averaged thickness of top model grid cell (m) plus patm/rho0/grav + Ocean_sfc%calving(:,:) = 0.0 ! time accumulated ice sheet calving (kg m-2) passed to ice model + Ocean_sfc%calving_hflx(:,:) = 0.0 ! time accumulated ice sheet calving heat flux (W m-2) passed to ice model Ocean_sfc%frazil(:,:) = 0.0 ! time accumulated frazil (J/m^2) passed to ice model Ocean_sfc%melt_potential(:,:) = 0.0 ! time accumulated melt potential (J/m^2) passed to ice model Ocean_sfc%OBLD(:,:) = 0.0 ! ocean boundary layer depth (m) @@ -932,6 +953,24 @@ subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, US, patm, press_ end subroutine convert_state_to_ocean_type +!> Converts the ice-shelf-to-ocean calving and calving_hflx variables from the ice-shelf state (ISS) type +!! to the ocean public type +subroutine convert_shelf_state_to_ocean_type(Ocean_sfc, CS, US) + type(ocean_public_type), & + target, intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface fields, whose elements + !! have their data set here. + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd, i, j + + call get_domain_extent(Ocean_sfc%Domain, isc_bnd, iec_bnd, jsc_bnd, jec_bnd) + + call ice_sheet_calving_to_ocean_sfc(CS,US,Ocean_sfc%calving(isc_bnd:iec_bnd,jsc_bnd:jec_bnd),& + Ocean_sfc%calving_hflx(isc_bnd:iec_bnd,jsc_bnd:jec_bnd)) + +end subroutine convert_shelf_state_to_ocean_type + !> This subroutine extracts the surface properties from the ocean's internal !! state and stores them in the ocean type returned to the calling ice model. !! It has to be separate from the ocean_initialization call because the coupler diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index e6a42ef7a7..397a4e4059 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2007,7 +2007,8 @@ end subroutine step_offline !! initializing the ocean state variables, and initializing subsidiary modules subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & Time_in, offline_tracer_mode, input_restart_file, diag_ptr, & - count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp, ensemble_num) + count_calls, tracer_flow_CSp, ice_shelf_CSp, waves_CSp, ensemble_num, & + calve_ice_shelf_bergs) type(time_type), target, intent(inout) :: Time !< model time, set in this routine type(time_type), intent(in) :: Time_init !< The start time for the coupled model's calendar type(param_file_type), intent(out) :: param_file !< structure indicating parameter file to parse @@ -2030,6 +2031,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & optional, pointer :: Waves_CSp !< An optional pointer to a wave property CS integer, optional :: ensemble_num !< Ensemble index provided by the cap (instead of FMS !! ensemble manager) + logical, optional :: calve_ice_shelf_bergs !< If true, will add point iceberg calving variables to the ice + !! shelf restart ! local variables type(ocean_grid_type), pointer :: G => NULL() ! A pointer to the metric grid use for the run type(ocean_grid_type), pointer :: G_in => NULL() ! Pointer to the input grid @@ -2043,6 +2046,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & type(MOM_restart_CS), pointer :: restart_CSp => NULL() character(len=4), parameter :: vers_num = 'v2.0' integer :: turns ! Number of grid quarter-turns + logical :: point_calving ! Initial state on the input index map real, allocatable :: u_in(:,:,:) ! Initial zonal velocities [L T-1 ~> m s-1] @@ -2903,6 +2907,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & ! Consider removing this later? G%ke = GV%ke + if (use_ice_shelf) then + point_calving=.false.; if (present(calve_ice_shelf_bergs)) point_calving=calve_ice_shelf_bergs + endif + if (CS%rotate_index) then G_in%ke = GV%ke @@ -2928,7 +2936,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & ! when using an ice shelf. Passing the ice shelf diagnostics CS from MOM ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr, & - Time_init, dirs%output_directory) + Time_init, dirs%output_directory, calve_ice_shelf_bergs=point_calving) allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(mass_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) @@ -2987,7 +2995,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & deallocate(frac_shelf_in,mass_shelf_in) else if (use_ice_shelf) then - call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr, Time_init, dirs%output_directory) + call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr, Time_init, & + dirs%output_directory, calve_ice_shelf_bergs=point_calving) allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) allocate(CS%mass_shelf(isd:ied, jsd:jed), source=0.0) call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h, CS%mass_shelf) diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index b9640502d2..3f4c260eb4 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -8,11 +8,12 @@ module MOM_ice_shelf use MOM_constants, only : hlf use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_ROUTINE -use MOM_coms, only : num_PEs +use MOM_coms, only : num_PEs, reproducing_sum use MOM_data_override, only : data_override use MOM_diag_mediator, only : MOM_diag_ctrl=>diag_ctrl -use MOM_IS_diag_mediator, only : post_data=>post_IS_data +use MOM_IS_diag_mediator, only : post_data=>post_IS_data, post_scalar_data=>post_IS_data_0d use MOM_IS_diag_mediator, only : register_diag_field=>register_MOM_IS_diag_field, safe_alloc_ptr +use MOM_IS_diag_mediator, only : register_scalar_field=>register_MOM_IS_scalar_field use MOM_IS_diag_mediator, only : set_IS_axes_info, diag_ctrl, time_type use MOM_IS_diag_mediator, only : MOM_IS_diag_mediator_init, MOM_IS_diag_mediator_end use MOM_IS_diag_mediator, only : set_IS_diag_mediator_grid @@ -51,7 +52,8 @@ module MOM_ice_shelf use MOM_ice_shelf_dynamics, only : ice_shelf_dyn_CS, update_ice_shelf, write_ice_shelf_energy use MOM_ice_shelf_dynamics, only : register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn use MOM_ice_shelf_dynamics, only : ice_shelf_min_thickness_calve, change_in_draft -use MOM_ice_shelf_dynamics, only : ice_time_step_CFL, ice_shelf_dyn_end +use MOM_ice_shelf_dynamics, only : ice_time_step_CFL, ice_shelf_dyn_end, IS_dynamics_post_data +use MOM_ice_shelf_dynamics, only : volume_above_floatation, masked_var_grounded use MOM_ice_shelf_initialize, only : initialize_ice_thickness !MJH use MOM_ice_shelf_initialize, only : initialize_ice_shelf_boundary use MOM_ice_shelf_state, only : ice_shelf_state, ice_shelf_state_end, ice_shelf_state_init @@ -75,6 +77,7 @@ module MOM_ice_shelf public shelf_calc_flux, initialize_ice_shelf, ice_shelf_end, ice_shelf_query public ice_shelf_save_restart, solo_step_ice_shelf, add_shelf_forces public initialize_ice_shelf_fluxes, initialize_ice_shelf_forces +public ice_sheet_calving_to_ocean_sfc ! 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 @@ -151,6 +154,8 @@ module MOM_ice_shelf !! will be called (note: GL_regularize and GL_couple !! should be exclusive) logical :: calve_to_mask !< If true, calve any ice that passes outside of a masked area + logical :: calve_ice_shelf_bergs=.false. !< If true, flux through a static ice front is converted + !! to point bergs real :: min_thickness_simple_calve !< min. ice shelf thickness criteria for calving [Z ~> m]. real :: T0 !< temperature at ocean surface in the restoring region [C ~> degC] real :: S0 !< Salinity at ocean surface in the restoring region [S ~> ppt]. @@ -206,7 +211,12 @@ module MOM_ice_shelf id_surf_elev = -1, id_bathym = -1, & id_area_shelf_h = -1, & id_ustar_shelf = -1, id_shelf_mass = -1, id_mass_flux = -1, & - id_shelf_sfc_mass_flux = -1 + id_shelf_sfc_mass_flux = -1, & + id_vaf = -1, id_g_adott = -1, id_f_adott = -1, id_adott = -1, & + id_bdott_melt = -1, id_bdott_accum = -1, id_bdott = -1, & + id_dvafdt = -1, id_g_adot = -1, id_f_adot = -1, id_adot = -1, & + id_bdot_melt = -1, id_bdot_accum = -1, id_bdot = -1, & + id_t_area = -1, id_g_area = -1, id_f_area = -1 !>@} type(external_field) :: mass_handle @@ -264,7 +274,10 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & exch_vel_t, & !< Sub-shelf thermal exchange velocity [Z T-1 ~> m s-1] - exch_vel_s !< Sub-shelf salt exchange velocity [Z T-1 ~> m s-1] + exch_vel_s, & !< Sub-shelf salt exchange velocity [Z T-1 ~> m s-1] + tmp, & !< Temporary field used when calculating diagnostics [various] + dh_bdott, & !< Basal melt/accumulation over a time step, used for diagnostics [Z ~> m] + dh_adott !< Surface melt/accumulation over a time step, used for diagnostics [Z ~> m] real, dimension(SZDI_(CS%grid),SZDJ_(CS%grid)) :: & mass_flux !< Total mass flux of freshwater across the ice-ocean interface. [R Z L2 T-1 ~> kg s-1] @@ -333,6 +346,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) character(len=160) :: mesg ! The text of an error message integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, is, ie, js, je, ied, jed, it1, it3 + real :: vaf0, vaf ! The previous and current volume above floatation [m3] + logical :: smb_diag=.false., bmb_diag=.false. ! Flags to calculate diagnostics related to surface/basal mass balance + real :: val ! Temporary value when calculating scalar diagnostics [various] if (.not. associated(CS)) call MOM_error(FATAL, "shelf_calc_flux: "// & "initialize_ice_shelf must be called before shelf_calc_flux.") @@ -341,10 +357,21 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) G => CS%grid ; US => CS%US ISS => CS%ISS time_step = time_step_in + Itime_step = 1./time_step + if (CS%id_adott>0 .or. CS%id_g_adott>0 .or. CS%id_f_adott>0 .or. & + CS%id_adot >0 .or. CS%id_g_adot >0 .or. CS%id_f_adot >0 ) smb_diag=.true. + if (CS%id_bdott>0 .or. CS%id_bdott_melt>0 .or. CS%id_bdott_accum>0 .or. & + CS%id_bdot >0 .or. CS%id_bdot_melt >0 .or. CS%id_bdot_accum >0) bmb_diag=.true. + + if (CS%active_shelf_dynamics .and. CS%id_dvafdt > 0) & !calculate previous volume above floatation + call volume_above_floatation(CS%dCS, G, ISS, vaf0) + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed if (CS%data_override_shelf_fluxes .and. CS%active_shelf_dynamics) then - call data_override(G%Domain, 'shelf_sfc_mass_flux', fluxes_in%shelf_sfc_mass_flux, CS%Time, & + call data_override(G%Domain, 'shelf_sfc_mass_flux', fluxes_in%shelf_sfc_mass_flux(is:ie,js:je), CS%Time, & scale=US%kg_m2s_to_RZ_T) + call pass_var(fluxes_in%shelf_sfc_mass_flux, G%domain, complete=.true.) endif if (CS%rotate_index) then @@ -358,7 +385,6 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) fluxes => fluxes_in endif ! useful parameters - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; ied = G%ied ; jed = G%jed ZETA_N = CS%Zeta_N VK = CS%Vk RC = CS%Rc @@ -743,7 +769,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! Melting has been computed, now is time to update thickness and mass if ( CS%override_shelf_movement .and. (.not.CS%mass_from_file)) then + if (bmb_diag) dh_bdott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) call change_thickness_using_melt(ISS, G, US, time_step, fluxes, CS%density_ice, CS%debug) + if (bmb_diag) dh_bdott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) - dh_bdott(is:ie,js:je) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) @@ -757,7 +785,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ISS%dhdt_shelf(:,:) = ISS%h_shelf(:,:) + if (bmb_diag) dh_bdott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) call change_thickness_using_melt(ISS, G, US, time_step, fluxes, CS%density_ice, CS%debug) + if (bmb_diag) dh_bdott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) - dh_bdott(is:ie,js:je) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using melt", G%HI, haloshift=0, scale=US%Z_to_m) @@ -765,7 +795,9 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) scale=US%RZ_to_kg_m2) endif + if (smb_diag) dh_adott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) call change_thickness_using_precip(CS, ISS, G, US, fluxes, time_step, Time) + if (smb_diag) dh_adott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) - dh_adott(is:ie,js:je) if (CS%debug) then call hchksum(ISS%h_shelf, "h_shelf after change thickness using surf acc", G%HI, haloshift=0, scale=US%Z_to_m) @@ -778,13 +810,14 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) ! advect the ice shelf, and advance the front. Calving will be in here somewhere as well.. ! when we decide on how to do it - call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, & + call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, CS%calve_ice_shelf_bergs, & sfc_state%ocean_mass, coupled_GL) - Itime_step = 1./time_step do j=js,je ; do i=is,ie ISS%dhdt_shelf(i,j) = (ISS%h_shelf(i,j) - ISS%dhdt_shelf(i,j))*Itime_step enddo; enddo + + call IS_dynamics_post_data(time_step, Time, CS%dCS, G) endif if (CS%shelf_mass_is_dynamic) & @@ -816,9 +849,71 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf, ISS%h_shelf, CS%diag) if (CS%id_dhdt_shelf > 0) call post_data(CS%id_dhdt_shelf, ISS%dhdt_shelf, CS%diag) if (CS%id_h_mask > 0) call post_data(CS%id_h_mask,ISS%hmask,CS%diag) + !scalars + if (CS%active_shelf_dynamics) then + if (CS%id_vaf > 0 .or. CS%id_dvafdt > 0) & !calculate current volume above floatation (vaf) + call volume_above_floatation(CS%dCS, G, ISS, vaf) + if (CS%id_vaf > 0) call post_scalar_data(CS%id_vaf ,vaf ,CS%diag) !current vaf + if (CS%id_dvafdt > 0) call post_scalar_data(CS%id_dvafdt,(vaf-vaf0)*Itime_step,CS%diag) !d(vaf)/dt + if (CS%id_adott > 0 .or. CS%id_adot > 0) then !surface accumulation - surface melt + call integrate_over_ice_sheet_area(G, ISS, dh_adott, US%Z_to_m, val) + if (CS%id_adott > 0) call post_scalar_data(CS%id_adott,val ,CS%diag) + if (CS%id_adot > 0) call post_scalar_data(CS%id_adot ,val*Itime_step,CS%diag) + endif + if (CS%id_g_adott > 0 .or. CS%id_g_adot > 0) then !grounded only: surface accumulation - surface melt + call masked_var_grounded(G,CS%dCS,dh_adott,tmp) + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_g_adott > 0) call post_scalar_data(CS%id_g_adott,val ,CS%diag) + if (CS%id_g_adot > 0) call post_scalar_data(CS%id_g_adot ,val*Itime_step,CS%diag) + endif + if (CS%id_f_adott > 0 .or. CS%id_f_adot > 0) then !floating only: surface accumulation - surface melt + call masked_var_grounded(G,CS%dCS,dh_adott,tmp) + tmp(:,:) = dh_adott(:,:) - tmp(:,:) + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_f_adott > 0) call post_scalar_data(CS%id_f_adott,val ,CS%diag) + if (CS%id_f_adot > 0) call post_scalar_data(CS%id_f_adot ,val*Itime_step,CS%diag) + endif + endif + if (CS%id_bdott > 0 .or. CS%id_bdot > 0) then !bottom accumulation - bottom melt + call integrate_over_ice_sheet_area(G, ISS, dh_bdott, US%Z_to_m, val) + if (CS%id_bdott > 0) call post_scalar_data(CS%id_bdott,val ,CS%diag) + if (CS%id_bdot > 0) call post_scalar_data(CS%id_bdot ,val*Itime_step,CS%diag) + endif + if (CS%id_bdott_melt > 0 .or. CS%id_bdot_melt > 0) then !bottom melt + tmp(:,:)=0.0 + do j=js,je ; do i=is,ie + if (dh_bdott(i,j) < 0) tmp(i,j) = -dh_bdott(i,j) + enddo; enddo + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_bdott_melt > 0) call post_scalar_data(CS%id_bdott_melt,val ,CS%diag) + if (CS%id_bdot_melt > 0) call post_scalar_data(CS%id_bdot_melt ,val*Itime_step,CS%diag) + endif + if (CS%id_bdott_accum > 0 .or. CS%id_bdot_accum > 0) then !bottom accumulation + tmp(:,:)=0.0 + do j=js,je ; do i=is,ie + if (dh_bdott(i,j) > 0) tmp(i,j) = dh_bdott(i,j) + enddo; enddo + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_bdott_accum > 0) call post_scalar_data(CS%id_bdott_accum,val ,CS%diag) + if (CS%id_bdot_accum > 0) call post_scalar_data(CS%id_bdot_accum ,val*Itime_step,CS%diag) + endif + if (CS%id_t_area > 0) then + tmp(:,:) = 1.0; call integrate_over_ice_sheet_area(G, ISS, tmp, 1.0, val) + call post_scalar_data(CS%id_t_area,val,CS%diag) + endif + if (CS%id_g_area > 0 .or. CS%id_f_area > 0) then + tmp(:,:) = 1.0; call masked_var_grounded(G,CS%dCS,tmp,tmp) + if (CS%id_g_area > 0) then + call integrate_over_ice_sheet_area(G, ISS, tmp, 1.0, val) + call post_scalar_data(CS%id_g_area,val,CS%diag) + endif + if (CS%id_f_area > 0) then + call integrate_over_ice_sheet_area(G, ISS, 1.0-tmp, 1.0, val) + call post_scalar_data(CS%id_f_area,val,CS%diag) + endif + endif call disable_averaging(CS%diag) - call cpu_clock_end(id_clock_shelf) if (CS%rotate_index) then @@ -831,6 +926,48 @@ subroutine shelf_calc_flux(sfc_state_in, fluxes_in, Time, time_step_in, CS) end subroutine shelf_calc_flux +subroutine integrate_over_ice_sheet_area(G, ISS, var, var_scale, var_out) + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe the ice-shelf state + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< Ice variable to integrate in arbitrary units [A ~> a] + real, intent(in) :: var_scale !< Dimensional scaling for variable to integrate [a A-1 ~> 1] + real, intent(out) :: var_out !< Variable integrated over the area of the ice sheet in arbitrary units [a m2] + real, dimension(SZI_(G),SZJ_(G)) :: var_cell !< Variable integrated over the ice-sheet area of each cell + !! in arbitrary units [a m2] + integer :: i,j + + var_cell(:,:)=0.0 + do j = G%jsc,G%jec; do i = G%isc,G%iec + if (ISS%hmask(i,j)>0) var_cell(i,j) = (var(i,j) * var_scale) * (ISS%area_shelf_h(i,j) * G%US%L_to_m**2) + enddo; enddo + var_out = reproducing_sum(var_cell) +end subroutine integrate_over_ice_sheet_area + +!> Converts the ice-shelf-to-ocean calving and calving_hflx variables from the ice-shelf state (ISS) type +!! to the ocean public type +subroutine ice_sheet_calving_to_ocean_sfc(CS,US,calving,calving_hflx) + type(ice_shelf_CS), pointer :: CS !< A pointer to the ice shelf control structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(:,:), intent(inout) :: calving !< The mass flux per unit area of the ice shelf + !! to convert to bergs [R Z T-1 ~> kg m-2 s-1]. + real, dimension(:,:), intent(inout) :: calving_hflx !< Calving heat flux [Q R Z T-1 ~> W m-2]. + ! Local variables + type(ice_shelf_state), pointer :: ISS => NULL() !< A structure with elements that describe + !! the ice-shelf state + type(ocean_grid_type), pointer :: G => NULL() !< A pointer to the ocean grid metric. + integer :: is, ie, js, je + + G=>CS%Grid + ISS => CS%ISS + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + calving = US%RZ_T_to_kg_m2s * ISS%calving(is:ie,js:je) + calving_hflx = US%QRZ_T_to_W_m2 * ISS%calving_hflx(is:ie,js:je) + + !CS%calve_ice_shelf_bergs=.true. + +end subroutine ice_sheet_calving_to_ocean_sfc + !> Changes the thickness (mass) of the ice shelf based on sub-ice-shelf melting subroutine change_thickness_using_melt(ISS, G, US, time_step, fluxes, density_ice, debug) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. @@ -1243,7 +1380,7 @@ end subroutine add_shelf_flux !> Initializes shelf model data, parameters and diagnostics subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, directory, forces_in, & - fluxes_in, sfc_state_in, solo_ice_sheet_in) + fluxes_in, sfc_state_in, solo_ice_sheet_in, calve_ice_shelf_bergs) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(ocean_grid_type), pointer :: ocn_grid !< The calling ocean model's horizontal grid structure type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time @@ -1261,6 +1398,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, !! intent is only inout to allow for halo updates. logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether !! a solo ice-sheet driver. + logical, optional :: calve_ice_shelf_bergs !< If true, will add point iceberg calving variables to the ice + !! shelf restart type(ocean_grid_type), pointer :: G => NULL(), OG => NULL() ! Pointers to grids for convenience. type(unit_scale_type), pointer :: US => NULL() ! Pointer to a structure containing @@ -1671,6 +1810,8 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, units="m s-1", default=-1.0, scale=US%m_to_Z*US%T_to_s, & do_not_log=CS%ustar_shelf_from_vel) + if (present(calve_ice_shelf_bergs)) CS%calve_ice_shelf_bergs=calve_ice_shelf_bergs + ! Allocate and initialize state variables to default values call ice_shelf_state_init(CS%ISS, CS%grid) ISS => CS%ISS @@ -1726,6 +1867,14 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, "Ice shelf area in cell", "m2", conversion=US%L_to_m**2) call register_restart_field(ISS%h_shelf, "h_shelf", .true., CS%restart_CSp, & "ice sheet/shelf thickness", "m", conversion=US%Z_to_m) + + if (CS%calve_ice_shelf_bergs) then + call register_restart_field(ISS%calving, "shelf_calving", .true., CS%restart_CSp, & + "Calving flux from ice shelf into icebergs", "kg m-2", conversion=US%RZ_to_kg_m2) + call register_restart_field(ISS%calving_hflx, "shelf_calving_hflx", .true., CS%restart_CSp, & + "Calving heat flux from ice shelf into icebergs", "W m-2", conversion=US%QRZ_T_to_W_m2) + endif + if (PRESENT(sfc_state_in)) then if (allocated(sfc_state%taux_shelf) .and. allocated(sfc_state%tauy_shelf)) then u_desc = var_desc("taux_shelf", "Pa", "the zonal stress on the ocean under ice shelves", & @@ -1814,7 +1963,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, endif if (CS%shelf_mass_is_dynamic) & - call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, CS%diag, new_sim, & + call initialize_ice_shelf_dyn(param_file, Time, ISS, CS%dCS, G, US, CS%diag, new_sim, CS%Cp_ice, & Time_init, directory, solo_ice_sheet_in) call fix_restart_unit_scaling(US, unscaled=.true.) @@ -1879,6 +2028,47 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, Time_init, 'ice shelf surface mass flux deposition from atmosphere', & 'kg m-2 s-1', conversion=US%RZ_T_to_kg_m2s) endif + !scalars (area integrated) + CS%id_vaf = register_scalar_field('ice_shelf_model', 'int_vaf', CS%diag%axesT1, CS%Time, & + 'Area integrated ice sheet volume above floatation', 'm3') + CS%id_adott = register_scalar_field('ice_shelf_model', 'int_a', CS%diag%axesT1, CS%Time, & + 'Area integrated (entire ice sheet) change in ice-sheet thickness ' //& + 'due to surface accum+melt during a DT_THERM time step', 'm3') + CS%id_g_adott = register_scalar_field('ice_shelf_model', 'int_a_ground', CS%diag%axesT1, CS%Time, & + 'Area integrated change in grounded ice-sheet thickness ' //& + 'due to surface accum+melt during a DT_THERM time step', 'm3') + CS%id_f_adott = register_scalar_field('ice_shelf_model', 'int_a_float', CS%diag%axesT1, CS%Time, & + 'Area integrated change in floating ice-shelf thickness ' //& + 'due to surface accum+melt during a DT_THERM time step', 'm3') + CS%id_bdott = register_scalar_field('ice_shelf_model', 'int_b', CS%diag%axesT1, CS%Time, & + 'Area integrated change in floating ice-shelf thickness '//& + 'due to basal accum+melt during a DT_THERM time step', 'm3') + CS%id_bdott_melt = register_scalar_field('ice_shelf_model', 'int_b_melt', CS%diag%axesT1, CS%Time, & + 'Area integrated basal melt over ice shelves during a DT_THERM time step', 'm3') + CS%id_bdott_accum = register_scalar_field('ice_shelf_model', 'int_b_accum', CS%diag%axesT1, CS%Time, & + 'Area integrated basal accumulation over ice shelves during a DT_THERM a time step', 'm3') + CS%id_t_area = register_scalar_field('ice_shelf_model', 'tot_area', CS%diag%axesT1, CS%Time, & + 'Total area of entire ice-sheet', 'm2') + CS%id_f_area = register_scalar_field('ice_shelf_model', 'tot_area_float', CS%diag%axesT1, CS%Time, & + 'Total area of floating ice shelves', 'm2') + CS%id_g_area = register_scalar_field('ice_shelf_model', 'tot_area_ground', CS%diag%axesT1, CS%Time, & + 'Total area of grounded ice sheet', 'm2') + !scalars (area integrated rates) + CS%id_dvafdt = register_scalar_field('ice_shelf_model', 'int_vafdot', CS%diag%axesT1, CS%Time, & + 'Area integrated rate of change in ice-sheet volume above floatation', 'm3 s-1') + CS%id_adot = register_scalar_field('ice_shelf_model', 'int_adot', CS%diag%axesT1, CS%Time, & + 'Area integrated (full ice sheet) rate of change in ice-sheet thickness due to surface accum+melt', 'm3 s-1') + CS%id_g_adot = register_scalar_field('ice_shelf_model', 'int_adot_ground', CS%diag%axesT1, CS%Time, & + 'Area integrated rate of change in grounded ice-sheet thickness due to surface accum+melt', 'm3 s-1') + CS%id_f_adot = register_scalar_field('ice_shelf_model', 'int_adot_float', CS%diag%axesT1, CS%Time, & + 'Area integrated rate of change in floating ice-shelf thickness due to surface accum+melt', 'm3 s-1') + CS%id_bdot = register_scalar_field('ice_shelf_model', 'int_bdot', CS%diag%axesT1, CS%Time, & + 'Area integrated rate of change in ice-shelf thickness due to basal accum+melt', 'm3 s-1') + CS%id_bdot_melt = register_scalar_field('ice_shelf_model', 'int_bdot_melt', CS%diag%axesT1, CS%Time, & + 'Area integrated basal melt rate over ice shelves', 'm3 s-1') + CS%id_bdot_accum = register_scalar_field('ice_shelf_model', 'int_bdot_accum', CS%diag%axesT1, CS%Time, & + 'Area integrated basal accumulation rate over ice shelves', 'm3 s-1') + call MOM_IS_diag_mediator_close_registration(CS%diag) if (present(fluxes_in)) call initialize_ice_shelf_fluxes(CS, ocn_grid, US, fluxes_in) @@ -2241,6 +2431,13 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in logical :: coupled_GL ! If true the grounding line position is determined based on ! coupled ice-ocean dynamics. integer :: is, ie, js, je, i, j + real :: vaf0, vaf ! The previous and current volume above floatation [m3] + logical :: smb_diag=.false. ! Flags to calculate diagnostics related to surface/basal mass balance + real :: val ! Temporary value when calculating scalar diagnostics [various] + real, dimension(SZI_(CS%grid),SZJ_(CS%grid)) :: & + tmp, & ! Temporary field used when calculating diagnostics [various] + dh_adott_sum, & ! Surface melt/accumulation over a full time step, used for diagnostics [Z ~> m] + dh_adott ! Surface melt/accumulation over a partial time step, used for diagnostics [Z ~> m] G => CS%grid US => CS%US @@ -2262,6 +2459,15 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in ISS%dhdt_shelf(:,:) = ISS%h_shelf(:,:) + if (CS%id_adott>0 .or. CS%id_g_adott>0 .or. CS%id_f_adott>0 .or. & + CS%id_adot >0 .or. CS%id_g_adot >0 .or. CS%id_f_adot >0) then + smb_diag=.true. + dh_adott(:,:) = 0.0 ; dh_adott_sum(:,:) = 0.0 ; tmp(:,:) = 0.0 + endif + + if (CS%id_dvafdt > 0) & !calculate previous volume above floatation + call volume_above_floatation(CS%dCS, G, ISS, vaf0) + do while (remaining_time > 0.0) nsteps = nsteps+1 @@ -2275,7 +2481,10 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in call MOM_mesg("solo_step_ice_shelf: "//mesg, 5) endif + if (smb_diag) dh_adott(is:ie,js:je) = ISS%h_shelf(is:ie,js:je) call change_thickness_using_precip(CS, ISS, G, US, fluxes_in, time_step, Time) + if (smb_diag) dh_adott_sum(is:ie,js:je) = dh_adott_sum(is:ie,js:je) + & + (ISS%h_shelf(is:ie,js:je) - dh_adott(is:ie,js:je)) remaining_time = remaining_time - time_step @@ -2284,23 +2493,62 @@ subroutine solo_step_ice_shelf(CS, time_interval, nsteps, Time, min_time_step_in update_ice_vel = ((time_step > min_time_step) .or. (remaining_time > 0.0)) coupled_GL = .false. - call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, must_update_vel=update_ice_vel) + call update_ice_shelf(CS%dCS, ISS, G, US, time_step, Time, CS%calve_ice_shelf_bergs, & + must_update_vel=update_ice_vel) enddo - call write_ice_shelf_energy(CS%dCS, G, US, ISS%mass_shelf, Time, & - time_step=real_to_time(US%T_to_s*time_step) ) + call write_ice_shelf_energy(CS%dCS, G, US, ISS%mass_shelf, Time, time_step=time_interval) + do j=js,je ; do i=is,ie ISS%dhdt_shelf(i,j) = (ISS%h_shelf(i,j) - ISS%dhdt_shelf(i,j)) * Ifull_time_step enddo; enddo call enable_averages(full_time_step, Time, CS%diag) - if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h, ISS%area_shelf_h, CS%diag) - if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf, ISS%h_shelf, CS%diag) - if (CS%id_dhdt_shelf > 0) call post_data(CS%id_dhdt_shelf, ISS%dhdt_shelf, CS%diag) - if (CS%id_h_mask > 0) call post_data(CS%id_h_mask, ISS%hmask, CS%diag) + if (CS%id_area_shelf_h > 0) call post_data(CS%id_area_shelf_h ,ISS%area_shelf_h,CS%diag) + if (CS%id_h_shelf > 0) call post_data(CS%id_h_shelf ,ISS%h_shelf ,CS%diag) + if (CS%id_dhdt_shelf > 0) call post_data(CS%id_dhdt_shelf ,ISS%dhdt_shelf ,CS%diag) + if (CS%id_h_mask > 0) call post_data(CS%id_h_mask ,ISS%hmask ,CS%diag) + if (CS%id_vaf > 0 .or. CS%id_dvafdt > 0) & !calculate current volume above floatation (vaf) + call volume_above_floatation(CS%dCS, G, ISS, vaf) + if (CS%id_vaf > 0) call post_scalar_data(CS%id_vaf ,vaf ,CS%diag) !current vaf + if (CS%id_dvafdt > 0) call post_scalar_data(CS%id_dvafdt,(vaf-vaf0)*Ifull_time_step,CS%diag) !d(vaf)/dt + if (CS%id_adott > 0 .or. CS%id_adot > 0) then !surface accumulation - surface melt + call integrate_over_ice_sheet_area(G, ISS, dh_adott_sum, US%Z_to_m, val) + if (CS%id_adott > 0) call post_scalar_data(CS%id_adott,val ,CS%diag) + if (CS%id_adot > 0) call post_scalar_data(CS%id_adot ,val*Ifull_time_step,CS%diag) + endif + if (CS%id_g_adott > 0 .or. CS%id_g_adot > 0) then !grounded only: surface accumulation - surface melt + call masked_var_grounded(G,CS%dCS,dh_adott_sum,tmp) + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_g_adott > 0) call post_scalar_data(CS%id_g_adott,val ,CS%diag) + if (CS%id_g_adot > 0) call post_scalar_data(CS%id_g_adot ,val*Ifull_time_step,CS%diag) + endif + if (CS%id_f_adott > 0 .or. CS%id_f_adot > 0) then !floating only: surface accumulation - surface melt + call masked_var_grounded(G,CS%dCS,dh_adott_sum,tmp) + tmp(:,:) = dh_adott_sum(:,:) - tmp(:,:) + call integrate_over_ice_sheet_area(G, ISS, tmp, US%Z_to_m, val) + if (CS%id_f_adott > 0) call post_scalar_data(CS%id_f_adott,val ,CS%diag) + if (CS%id_f_adot > 0) call post_scalar_data(CS%id_f_adot ,val*Ifull_time_step,CS%diag) + endif + if (CS%id_t_area > 0) then + tmp(:,:) = 1.0; call integrate_over_ice_sheet_area(G, ISS, tmp, 1.0, val) + call post_scalar_data(CS%id_t_area,val,CS%diag) + endif + if (CS%id_g_area > 0 .or. CS%id_f_area > 0) then + tmp(:,:) = 1.0; call masked_var_grounded(G,CS%dCS,tmp,tmp) + if (CS%id_g_area > 0) then + call integrate_over_ice_sheet_area(G, ISS, tmp, 1.0, val) + call post_scalar_data(CS%id_g_area,val,CS%diag) + endif + if (CS%id_f_area > 0) then + call integrate_over_ice_sheet_area(G, ISS, 1.0-tmp, 1.0, val) + call post_scalar_data(CS%id_f_area,val,CS%diag) + endif + endif call disable_averaging(CS%diag) + call IS_dynamics_post_data(full_time_step, Time, CS%dCS, G) end subroutine solo_step_ice_shelf !> \namespace mom_ice_shelf diff --git a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 index 42fa63fd95..5ecfb9e788 100644 --- a/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 +++ b/src/ice_shelf/MOM_ice_shelf_diag_mediator.F90 @@ -27,6 +27,7 @@ module MOM_IS_diag_mediator public MOM_IS_diag_mediator_init, MOM_IS_diag_mediator_end, set_IS_diag_mediator_grid public MOM_IS_diag_mediator_close_registration, get_diag_time_end public MOM_diag_axis_init, register_static_field_infra +public register_MOM_IS_scalar_field, post_IS_data_0d !> 2D/3D axes type to contain 1D axes handles and pointers to masks type, public :: axesType @@ -344,6 +345,36 @@ subroutine post_IS_data(diag_field_id, field, diag_cs, is_static, mask) end subroutine post_IS_data +!> Make a real ice shelf scalar diagnostic available for averaging or output +subroutine post_IS_data_0d(diag_field_id, field, diag_cs, is_static) + integer, intent(in) :: diag_field_id !< The id for an output variable returned by a + !! previous call to register_diag_field. + real, intent(in) :: field !< real value being offered for output or averaging + !! in internally scaled arbitrary units [A ~> a] + type(diag_ctrl), target, intent(in) :: diag_CS !< Structure used to regulate diagnostic output + logical, optional, intent(in) :: is_static !< If true, this is a static field that is always offered. + ! Local variables + real :: locfield ! The field being offered in arbitrary unscaled units [a] + logical :: used, is_stat + type(diag_type), pointer :: diag => null() + + is_stat = .false. ; if (present(is_static)) is_stat = is_static + + call assert(diag_field_id < diag_cs%next_free_diag_id, & + 'post_data_0d: Unregistered diagnostic id') + diag => diag_cs%diags(diag_field_id) + + locfield = field + if (diag%conversion_factor /= 0.) & + locfield = locfield * diag%conversion_factor + + if (is_stat) then + used = send_data_infra(diag%fms_diag_id, locfield) + elseif (diag_cs%ave_enabled) then + used = send_data_infra(diag%fms_diag_id, locfield, diag_cs%time_end) + endif +end subroutine post_IS_data_0d + !> Enable the accumulation of time averages over the specified time interval. subroutine enable_averaging(time_int_in, time_end_in, diag_cs) @@ -429,22 +460,25 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & character(len=*), optional, intent(in) :: long_name !< Long name of a field. character(len=*), optional, intent(in) :: units !< Units of a field. character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field - real, optional, intent(in) :: missing_value !< A value that indicates missing values. + real, optional, intent(in) :: missing_value !< A value that indicates missing values in + !! output files, in unscaled arbitrary units [a] real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) + !! in arbitrary units [a] logical, optional, intent(in) :: mask_variant !< If true a logical mask must be provided with !! post_IS_data calls (not used in MOM?) logical, optional, intent(in) :: verbose !< If true, FMS is verbose (not used in MOM?) logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) character(len=*), optional, intent(out):: err_msg !< String into which an error message might be - !! placed (not used in MOM?) + !! placed (not used in MOM?) character(len=*), optional, intent(in) :: interp_method !< If 'none' indicates the field should not - !! be interpolated as a scalar - integer, optional, intent(in) :: tile_count !< no clue (not used in MOM_IS?) - real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file - + !! be interpolated as a scalar + integer, optional, intent(in) :: tile_count !< no clue (not used in MOM_IS?) + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file, + !! often including factors to undo internal scaling and + !! in units of [a A-1 ~> 1] ! Local variables character(len=240) :: mesg - real :: MOM_missing_value + real :: MOM_missing_value ! A value used to indicate missing values in output files, in arbitrary units [a] integer :: primary_id, fms_id type(diag_ctrl), pointer :: diag_cs => NULL() ! A structure that is used ! to regulate diagnostic output @@ -513,6 +547,71 @@ function register_MOM_IS_diag_field(module_name, field_name, axes, init_time, & end function register_MOM_IS_diag_field +!> Returns the "MOM_IS_diag_mediator" handle for a group of diagnostics derived from one scalar. +function register_MOM_IS_scalar_field(module_name, field_name, axes, init_time, & + long_name, units, missing_value, range, standard_name, & + do_not_log, err_msg, conversion) result (register_scalar_field) + integer :: register_scalar_field !< The returned diagnostic handle + character(len=*), intent(in) :: module_name !< Name of this module, usually "ice_model" + character(len=*), intent(in) :: field_name !< Name of the diagnostic field + type(axesType), intent(in) :: axes !< The axis group for this field + type(time_type), intent(in) :: init_time !< Time at which a field is first available? + character(len=*), optional, intent(in) :: long_name !< Long name of a field. + character(len=*), optional, intent(in) :: units !< Units of a field. + character(len=*), optional, intent(in) :: standard_name !< Standardized name associated with a field + real, optional, intent(in) :: missing_value !< A value that indicates missing values. + real, optional, intent(in) :: range(2) !< Valid range of a variable (not used in MOM?) + logical, optional, intent(in) :: do_not_log !< If true, do not log something (not used in MOM?) + character(len=*), optional, intent(out):: err_msg !< String into which an error message might be + !! placed (not used in MOM?) + real, optional, intent(in) :: conversion !< A value to multiply data by before writing to file + + ! Local variables + character(len=240) :: mesg + real :: MOM_missing_value + integer :: primary_id, fms_id + type(diag_ctrl), pointer :: diag_cs => NULL() ! A structure that is used + ! to regulate diagnostic output + type(diag_type), pointer :: diag => NULL() + + MOM_missing_value = axes%diag_cs%missing_value + if (present(missing_value)) MOM_missing_value = missing_value + + diag_cs => axes%diag_cs + primary_id = -1 + + fms_id = register_diag_field_infra(module_name, field_name, & + init_time, long_name=long_name, units=units, missing_value=MOM_missing_value, & + range=range, standard_name=standard_name, do_not_log=do_not_log, err_msg=err_msg) + + if (fms_id > 0) then + primary_id = get_new_diag_id(diag_cs) + diag => diag_cs%diags(primary_id) + diag%fms_diag_id = fms_id + if (len(field_name) > len(diag%name)) then + diag%name = field_name(1:len(diag%name)) + else ; diag%name = field_name ; endif + + if (present(conversion)) diag%conversion_factor = conversion + endif + + if (is_root_pe() .and. diag_CS%doc_unit > 0) then + if (primary_id > 0) then + mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Used]' + else + mesg = '"'//trim(module_name)//'", "'//trim(field_name)//'" [Unused]' + endif + write(diag_CS%doc_unit, '(a)') trim(mesg) + if (present(long_name)) call describe_option("long_name", long_name, diag_CS) + if (present(units)) call describe_option("units", units, diag_CS) + if (present(standard_name)) & + call describe_option("standard_name", standard_name, diag_CS) + endif + + register_scalar_field = primary_id + +end function register_MOM_IS_scalar_field + !> Registers a static diagnostic, returning an integer handle function register_MOM_IS_static_field(module_name, field_name, axes, & long_name, units, missing_value, range, mask_variant, standard_name, & diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index ec49081baf..27cb4721bf 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -34,9 +34,10 @@ module MOM_ice_shelf_dynamics #include -public register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn, update_ice_shelf +public register_ice_shelf_dyn_restarts, initialize_ice_shelf_dyn, update_ice_shelf, IS_dynamics_post_data public ice_time_step_CFL, ice_shelf_dyn_end, change_in_draft, write_ice_shelf_energy -public shelf_advance_front, ice_shelf_min_thickness_calve, calve_to_mask +public shelf_advance_front, ice_shelf_min_thickness_calve, calve_to_mask, volume_above_floatation +public masked_var_grounded ! 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 @@ -133,6 +134,7 @@ module MOM_ice_shelf_dynamics real :: g_Earth !< The gravitational acceleration [L2 Z-1 T-2 ~> m s-2]. real :: density_ice !< A typical density of ice [R ~> kg m-3]. + real :: Cp_ice !< The heat capacity of fresh ice [Q C-1 ~> J kg-1 degC-1]. logical :: advect_shelf !< If true (default), advect ice shelf and evolve thickness logical :: alternate_first_direction_IS !< If true, alternate whether the x- or y-direction @@ -388,7 +390,7 @@ subroutine register_ice_shelf_dyn_restarts(G, US, param_file, CS, restart_CS) end subroutine register_ice_shelf_dyn_restarts !> Initializes shelf model data, parameters and diagnostics -subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_sim, & +subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_sim, Cp_ice, & Input_start_time, directory, solo_ice_sheet_in) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(time_type), intent(inout) :: Time !< The clock that that will indicate the model time @@ -400,6 +402,7 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate the diagnostic output. logical, intent(in) :: new_sim !< If true this is a new simulation, otherwise !! has been started from a restart file. + real, intent(in) :: Cp_ice !< Heat capacity of ice [Q C-1 ~> J kg-1 degC-1] type(time_type), intent(in) :: Input_start_time !< The start time of the simulation. character(len=*), intent(in) :: directory !< The directory where the ice sheet energy file goes. logical, optional, intent(in) :: solo_ice_sheet_in !< If present, this indicates whether @@ -552,7 +555,8 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", CS%min_thickness_simple_calve, & "Min thickness rule for the VERY simple calving law",& units="m", default=0.0, scale=US%m_to_Z) - + CS%Cp_ice = Cp_ice !Heat capacity of ice (J kg-1 K-1), needed for heat flux of any bergs calved from + !the ice shelf and for ice sheet temperature solver !for write_ice_shelf_energy ! Note that the units of CS%Timeunit are the MKS units of [s]. call get_param(param_file, mdl, "TIMEUNIT", CS%Timeunit, & @@ -774,6 +778,15 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ 'taub', 'MPa s m-1', conversion=1e-6*US%RL2_T2_to_Pa/(365.0*86400.0*US%L_T_to_m_s)) CS%id_OD_av = register_diag_field('ice_shelf_model','OD_av',CS%diag%axesT1, Time, & 'intermediate ocean column thickness passed to ice model', 'm', conversion=US%Z_to_m) + + !Update these variables so that they are nonzero in case + !IS_dynamics_post_data is called before update_ice_shelf + if (CS%id_taudx_shelf>0 .or. CS%id_taudy_shelf>0) & + call calc_shelf_driving_stress(CS, ISS, G, US, CS%taudx_shelf, CS%taudy_shelf, CS%OD_av) + if (CS%id_taub>0) & + call calc_shelf_taub(CS, ISS, G, US, CS%u_shelf, CS%v_shelf) + if (CS%id_visc_shelf>0) & + call calc_shelf_visc(CS, ISS, G, US, CS%u_shelf, CS%v_shelf) endif if (new_sim) then @@ -850,7 +863,8 @@ end function ice_time_step_CFL !> This subroutine updates the ice shelf velocities, mass, stresses and properties due to the !! ice shelf dynamics. -subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled_grounding, must_update_vel) +subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, calve_ice_shelf_bergs, & + ocean_mass, coupled_grounding, must_update_vel) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state @@ -858,17 +872,14 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled type(unit_scale_type), intent(in) :: US !< A structure containing unit conversion factors real, intent(in) :: time_step !< time step [T ~> s] type(time_type), intent(in) :: Time !< The current model time + logical, intent(in) :: calve_ice_shelf_bergs !< To convert ice flux through front + !! to bergs real, dimension(SZDI_(G),SZDJ_(G)), & optional, intent(in) :: ocean_mass !< If present this is the mass per unit area !! of the ocean [R Z ~> kg m-2]. logical, optional, intent(in) :: coupled_grounding !< If true, the grounding line is !! determined by coupled ice-ocean dynamics logical, optional, intent(in) :: must_update_vel !< Always update the ice velocities if true. - real, dimension(SZDIB_(G),SZDJB_(G)) :: taud_x, taud_y ! Pa] - real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc !< area-averaged vertically integrated ice viscosity - !! [R L2 Z T-1 ~> Pa s m] - real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged taub_beta field related to basal traction, - !! [R L1 T-1 ~> Pa s m-1] integer :: iters logical :: update_ice_vel, coupled_GL @@ -879,7 +890,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (present(ocean_mass) .and. present(coupled_grounding)) coupled_GL = coupled_grounding ! if (CS%advect_shelf) then - call ice_shelf_advect(CS, ISS, G, time_step, Time) + call ice_shelf_advect(CS, ISS, G, time_step, Time, calve_ice_shelf_bergs) if (CS%alternate_first_direction_IS) then CS%first_direction_IS = modulo(CS%first_direction_IS+1,2) CS%first_dir_restart_IS = real(CS%first_direction_IS) @@ -897,12 +908,71 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled if (update_ice_vel) then call ice_shelf_solve_outer(CS, ISS, G, US, CS%u_shelf, CS%v_shelf,CS%taudx_shelf,CS%taudy_shelf, iters, Time) + CS%elapsed_velocity_time = 0.0 endif ! call ice_shelf_temp(CS, ISS, G, US, time_step, ISS%water_flux, Time) - if (CS%elapsed_velocity_time >= CS%velocity_update_time_step) then - call enable_averages(CS%elapsed_velocity_time, Time, CS%diag) +end subroutine update_ice_shelf + +subroutine volume_above_floatation(CS, G, ISS, vaf) + type(ice_shelf_dyn_CS), intent(in) :: CS !< The ice shelf dynamics control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_state), intent(in) :: ISS !< A structure with elements that describe + !! the ice-shelf state + real, intent(out) :: vaf !< area integrated volume above floatation [m3] + real, dimension(SZI_(G),SZJ_(G)) :: vaf_cell !< cell-wise volume above floatation [m3] + integer :: is,ie,js,je,i,j + real :: rhoi_rhow, rhow_rhoi + + if (CS%GL_couple) & + call MOM_error(FATAL, "MOM_ice_shelf_dyn, volume above floatation calculation assumes GL_couple=.FALSE..") + + vaf_cell(:,:)=0.0 + rhoi_rhow = CS%density_ice / CS%density_ocean_avg + rhow_rhoi = CS%density_ocean_avg / CS%density_ice + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + + do j = js,je; do i = is,ie + if (ISS%hmask(i,j)>0) then + if (CS%bed_elev(i,j) <= 0) then + !grounded above sea level + vaf_cell(i,j)= (ISS%h_shelf(i,j) * G%US%Z_to_m) * (ISS%area_shelf_h(i,j) * G%US%L_to_m**2) + else + !grounded if vaf_cell(i,j) > 0 + vaf_cell(i,j) = (max(ISS%h_shelf(i,j) - rhow_rhoi * CS%bed_elev(i,j), 0.0) * G%US%Z_to_m) * & + (ISS%area_shelf_h(i,j) * G%US%L_to_m**2) + endif + endif + enddo; enddo + + vaf = reproducing_sum(vaf_cell) +end subroutine volume_above_floatation + +!> multiplies a variable with the ice sheet grounding fraction +subroutine masked_var_grounded(G,CS,var,varout) + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + type(ice_shelf_dyn_CS), intent(in) :: CS !< The ice shelf dynamics control structure + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: var !< variable in + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: varout ! Ice shelf dynamics post_data calls +subroutine IS_dynamics_post_data(time_step, Time, CS, G) + real :: time_step !< Length of time for post data averaging [T ~> s]. + type(time_type), intent(in) :: Time !< The current model time + type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure + type(ocean_grid_type), intent(in) :: G !< The grid structure used by the ice shelf. + real, dimension(SZDIB_(G),SZDJB_(G)) :: taud_x, taud_y ! Pa] + real, dimension(SZDI_(G),SZDJ_(G)) :: ice_visc !< area-averaged vertically integrated ice viscosity + !! [R L2 Z T-1 ~> Pa s m] + real, dimension(SZDI_(G),SZDJ_(G)) :: basal_tr !< area-averaged taub_beta field related to basal traction, + !! [R L1 T-1 ~> Pa s m-1] + call enable_averages(time_step, Time, CS%diag) if (CS%id_col_thick > 0) call post_data(CS%id_col_thick, CS%OD_av, CS%diag) if (CS%id_u_shelf > 0) call post_data(CS%id_u_shelf, CS%u_shelf, CS%diag) if (CS%id_v_shelf > 0) call post_data(CS%id_v_shelf, CS%v_shelf, CS%diag) @@ -931,7 +1001,6 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled basal_tr(:,:) = CS%basal_traction(:,:)*G%IareaT(:,:) call post_data(CS%id_taub, basal_tr, CS%diag) endif -!! if (CS%id_u_mask > 0) call post_data(CS%id_u_mask, CS%umask, CS%diag) if (CS%id_v_mask > 0) call post_data(CS%id_v_mask, CS%vmask, CS%diag) if (CS%id_ufb_mask > 0) call post_data(CS%id_ufb_mask, CS%u_face_mask_bdry, CS%diag) @@ -939,11 +1008,7 @@ subroutine update_ice_shelf(CS, ISS, G, US, time_step, Time, ocean_mass, coupled ! if (CS%id_t_mask > 0) call post_data(CS%id_t_mask, CS%tmask, CS%diag) call disable_averaging(CS%diag) - - CS%elapsed_velocity_time = 0.0 - endif - -end subroutine update_ice_shelf +end subroutine IS_dynamics_post_data !> Writes the total ice shelf kinetic energy and mass to an ascii file subroutine write_ice_shelf_energy(CS, G, US, mass, day, time_step) @@ -1080,14 +1145,15 @@ end subroutine write_ice_shelf_energy !> This subroutine takes the velocity (on the Bgrid) and timesteps h_t = - div (uh) once. !! Additionally, it will update the volume of ice in partially-filled cells, and update !! hmask accordingly -subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) +subroutine ice_shelf_advect(CS, ISS, G, time_step, Time, calve_ice_shelf_bergs) type(ice_shelf_dyn_CS), intent(inout) :: CS !< The ice shelf dynamics control structure type(ice_shelf_state), intent(inout) :: ISS !< A structure with elements that describe !! the ice-shelf state type(ocean_grid_type), intent(inout) :: G !< The grid structure used by the ice shelf. real, intent(in) :: time_step !< time step [T ~> s] type(time_type), intent(in) :: Time !< The current model time - + logical, intent(in) :: calve_ice_shelf_bergs !< If true, track ice shelf flux through a + !! static ice shelf, so that it can be converted into icebergs ! 3/8/11 DNG ! @@ -1155,6 +1221,23 @@ subroutine ice_shelf_advect(CS, ISS, G, time_step, Time) if (CS%calve_to_mask) then call calve_to_mask(G, ISS%h_shelf, ISS%area_shelf_h, ISS%hmask, CS%calve_mask) endif + elseif (calve_ice_shelf_bergs) then + !advect the front to create partially-filled cells + call shelf_advance_front(CS, ISS, G, ISS%hmask, uh_ice, vh_ice) + !add mass of the partially-filled cells to calving field, which is used to initialize icebergs + !Then, remove the partially-filled cells from the ice shelf + ISS%calving(:,:)=0.0 + ISS%calving_hflx(:,:)=0.0 + do j=jsc,jec; do i=isc,iec + if (ISS%hmask(i,j)==2) then + ISS%calving(i,j) = (ISS%h_shelf(i,j) * CS%density_ice) * & + (ISS%area_shelf_h(i,j) * G%IareaT(i,j)) / time_step + ISS%calving_hflx(i,j) = (CS%Cp_ice * CS%t_shelf(i,j)) * & + ((ISS%h_shelf(i,j) * CS%density_ice) * & + (ISS%area_shelf_h(i,j) * G%IareaT(i,j))) + ISS%h_shelf(i,j) = 0.0; ISS%area_shelf_h(i,j) = 0.0; ISS%hmask(i,j) = 0.0 + endif + enddo; enddo endif do j=jsc,jec; do i=isc,iec diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index e6be780073..d789c08bd4 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -46,9 +46,13 @@ module MOM_ice_shelf_state tflux_shelf => NULL(), & !< The downward diffusive heat flux in the ice !! shelf at the ice-ocean interface [Q R Z T-1 ~> W m-2]. - tfreeze => NULL() !< The freezing point potential temperature + tfreeze => NULL(), & !< The freezing point potential temperature !! at the ice-ocean interface [C ~> degC]. + !only active when calve_ice_shelf_bergs=true: + calving => NULL(), & !< The mass flux per unit area of the ice shelf to convert to + !! bergs [R Z T-1 ~> kg m-2 s-1]. + calving_hflx => NULL() !< Calving heat flux [Q R Z T-1 ~> W m-2]. end type ice_shelf_state contains @@ -80,6 +84,8 @@ subroutine ice_shelf_state_init(ISS, G) allocate(ISS%tflux_shelf(isd:ied,jsd:jed), source=0.0 ) allocate(ISS%tfreeze(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%calving(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%calving_hflx(isd:ied,jsd:jed), source=0.0 ) end subroutine ice_shelf_state_init @@ -94,6 +100,8 @@ subroutine ice_shelf_state_end(ISS) deallocate(ISS%tflux_ocn, ISS%water_flux, ISS%salt_flux, ISS%tflux_shelf) deallocate(ISS%tfreeze) + deallocate(ISS%calving, ISS%calving_hflx) + deallocate(ISS) end subroutine ice_shelf_state_end From d8e714e283364c29a0e5b8dcba514f05216ac65e Mon Sep 17 00:00:00 2001 From: Robert Hallberg Date: Fri, 5 Apr 2024 09:09:08 -0400 Subject: [PATCH 19/21] +(*)Refactor Idealize_Hurricane Refactored the Idealized_Hurricane module to clean up strange or unscaled variable units and eliminate dimensional scaling factors with the latest answer dates. This includes the introduction of 18 new runtime variables to replace hard-coded dimensional constants and two runtime logical flags to reproduce existing bugs. An inconsistency in the sign convention for the distance from the hurricane center with idealized_hurricane_wind_forcing in (the probably not yet used) single column mode was also corrected. Also added descriptions with units for all the variables in this module. By default or with appropriate parameter settings all answers are bitwise identical. --- src/user/Idealized_Hurricane.F90 | 564 +++++++++++++++++++++---------- 1 file changed, 380 insertions(+), 184 deletions(-) diff --git a/src/user/Idealized_Hurricane.F90 b/src/user/Idealized_Hurricane.F90 index 0c9d5cd330..c47366b23c 100644 --- a/src/user/Idealized_Hurricane.F90 +++ b/src/user/Idealized_Hurricane.F90 @@ -13,10 +13,9 @@ module Idealized_hurricane ! The T/S initializations have been removed since they are redundant ! w/ T/S initializations in CVMix_tests (which should be moved ! into the main state_initialization to their utility -! for multiple example cases).. +! for multiple example cases). ! To do ! 1. Remove the legacy SCM_idealized_hurricane_wind_forcing code -! 2. Make the hurricane-to-background wind transition a runtime parameter ! use MOM_error_handler, only : MOM_error, FATAL @@ -49,6 +48,10 @@ module Idealized_hurricane real :: pressure_ambient !< Pressure at surface of ambient air [R L2 T-2 ~> Pa] real :: pressure_central !< Pressure at surface at hurricane center [R L2 T-2 ~> Pa] real :: rad_max_wind !< Radius of maximum winds [L ~> m] + real :: rad_edge !< Radius of the edge of the hurricane, normalized by + !! the radius of maximum winds [nondim] + real :: rad_ambient !< Radius at which the winds are at their ambient background values, + !! normalized by the radius of maximum winds [nondim] real :: max_windspeed !< Maximum wind speeds [L T-1 ~> m s-1] real :: hurr_translation_spd !< Hurricane translation speed [L T-1 ~> m s-1] real :: hurr_translation_dir !< Hurricane translation direction [radians] @@ -60,34 +63,60 @@ module Idealized_hurricane real :: Hurr_cen_X0 !< The initial x position of the hurricane !! This experiment is conducted in a Cartesian !! grid and this is assumed to be in meters [L ~> m] - real :: Holland_A !< Parameter 'A' from the Holland formula [nondim] real :: Holland_B !< Parameter 'B' from the Holland formula [nondim] - real :: Holland_AxBxDP !< 'A' x 'B' x (Pressure Ambient-Pressure central) - !! for the Holland prorfile calculation [R L2 T-2 ~> Pa] logical :: relative_tau !< A logical to take difference between wind !! and surface currents to compute the stress integer :: answer_date !< The vintage of the expressions in the idealized hurricane !! test case. Values below 20190101 recover the answers !! from the end of 2018, while higher values use expressions !! that are rescalable and respect rotational symmetry. + ! Parameters used in a simple wind-speed dependent expression for C_drag + real :: Cd_calm !< The drag coefficient with weak relative winds [nondim] + real :: calm_speed !< The relative wind speed below which the drag coefficient takes its + !! calm value [L T-1 ~> m s-1] + real :: Cd_windy !< The drag coefficient with strong relative winds [nondim] + real :: windy_speed !< The relative wind speed below which the drag coefficient takes its + !! windy value [L T-1 ~> m s-1] + real :: dCd_dU10 !< The partial derivative of the drag coefficient times 1000 with the 10 m + !! wind speed for intermediate wind speeds [T L-1 ~> s m-1] + real :: Cd_intercept !< The zero-wind intercept times 1000 of the linear fit for the drag + !! coefficient for the intermediate speeds where there is a linear + !! dependence on the 10 m wind speed [nondim] + + ! Parameters used to set the inflow angle as a function of radius and maximum wind speed + real :: A0_0 !< The zero-radius, zero-speed intercept of the axisymmetric inflow angle [degrees] + real :: A0_Rnorm !< The normalized radius dependence of the axisymmetric inflow angle [degrees] + real :: A0_speed !< The maximum wind speed dependence of the axisymmetric inflow angle + !! [degrees T L-1 ~> degrees s m-1] + real :: A1_0 !< The zero-radius, zero-speed intercept of the normalized inflow angle + !! asymmetry [degrees] + real :: A1_Rnorm !< The normalized radius dependence of the normalized inflow angle asymmetry [degrees] + real :: A1_speed !< The translation speed dependence of the normalized inflow angle asymmetry + !! [degrees T L-1 ~> degrees s m-1] + real :: P1_0 !< The zero-radius, zero-speed intercept of the angle difference between the + !! translation direction and the inflow direction [degrees] + real :: P1_Rnorm !< The normalized radius dependence of the angle difference between the + !! translation direction and the inflow direction [degrees] + real :: P1_speed !< The translation speed dependence of the angle difference between the + !! translation direction and the inflow direction [degrees T L-1 ~> degrees s m-1] ! Parameters used if in SCM (single column model) mode - logical :: SCM_mode !< If true this being used in Single Column Model mode - logical :: BR_BENCH !< A "benchmark" configuration (which is meant to - !! provide identical wind to reproduce a previous - !! experiment, where that wind formula contained - !! an error) + logical :: SCM_mode !< If true this being used in Single Column Model mode + logical :: edge_taper_bug !< If true and SCM_mode is true, use a bug that does all of the tapering + !! and inflow angle calculations for radii between RAD_EDGE and RAD_AMBIENT + !! as though they were at RAD_EDGE. + real :: f_column !< Coriolis parameter used in the single column mode idealized + !! hurricane wind profile [T-1 ~> s-1] + logical :: BR_Bench !< A "benchmark" configuration (which is meant to + !! provide identical wind to reproduce a previous + !! experiment, where that wind formula contained an error) real :: dy_from_center !< (Fixed) distance in y from storm center path [L ~> m] - ! Par - real :: PI !< Mathematical constant - real :: Deg2Rad !< Mathematical constant + real :: pi !< The circumference of a circle divided by its diameter [nondim] + real :: Deg2Rad !< The conversion factor from degrees to radians [radian degree-1] end type -! This include declares and sets the variable "version". -#include "version_variable.h" - character(len=40) :: mdl = "idealized_hurricane" !< This module's name. contains @@ -102,8 +131,11 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) ! Local variables real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa] - real :: C ! A temporary variable [nondim] + real :: C ! A temporary variable in units of the square root of a specific volume [sqrt(m3 kg-1)] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. + logical :: continuous_Cd ! If true, use a continuous form for the simple drag coefficient as a + ! function of wind speed with the idealized hurricane. When this is false, the + ! linear shape for the mid-range wind speeds is specified separately. ! This include declares and sets the variable "version". # include "version_variable.h" @@ -132,16 +164,22 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) call get_param(param_file, mdl, "IDL_HURR_CENTRAL_PRESSURE", CS%pressure_central, & "Central pressure used in the idealized hurricane wind profile.", & units='Pa', default=96800., scale=US%Pa_to_RL2_T2) - call get_param(param_file, mdl, "IDL_HURR_RAD_MAX_WIND", & - CS%rad_max_wind, "Radius of maximum winds used in the "//& - "idealized hurricane wind profile.", & + call get_param(param_file, mdl, "IDL_HURR_RAD_MAX_WIND", CS%rad_max_wind, & + "Radius of maximum winds used in the idealized hurricane wind profile.", & units='m', default=50.e3, scale=US%m_to_L) + call get_param(param_file, mdl, "IDL_HURR_RAD_EDGE", CS%rad_edge, & + "Radius of the edge of the hurricane, normalized by the radius of maximum winds.", & + units='nondim', default=10.0) + call get_param(param_file, mdl, "IDL_HURR_RAD_AMBIENT", CS%rad_ambient, & + "Radius at which the winds are at their ambient background values, "//& + "normalized by the radius of maximum winds.", & + units='nondim', default=CS%rad_edge+2.0) call get_param(param_file, mdl, "IDL_HURR_MAX_WIND", CS%max_windspeed, & - "Maximum wind speed used in the idealized hurricane"// & - "wind profile.", units='m/s', default=65., scale=US%m_s_to_L_T) + "Maximum wind speed used in the idealized hurricane wind profile.", & + units='m/s', default=65., scale=US%m_s_to_L_T) call get_param(param_file, mdl, "IDL_HURR_TRAN_SPEED", CS%hurr_translation_spd, & - "Translation speed of hurricane used in the idealized "//& - "hurricane wind profile.", units='m/s', default=5.0, scale=US%m_s_to_L_T) + "Translation speed of hurricane used in the idealized hurricane wind profile.", & + units='m/s', default=5.0, scale=US%m_s_to_L_T) call get_param(param_file, mdl, "IDL_HURR_TRAN_DIR", CS%hurr_translation_dir, & "Translation direction (towards) of hurricane used in the "//& "idealized hurricane wind profile.", & @@ -156,17 +194,67 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) "Current relative stress switch used in the idealized hurricane wind profile.", & default=.false.) + call get_param(param_file, mdl, "IDL_HURR_AXI_INFLOW_0", CS%A0_0, & + "The zero-radius asymmetry, zero-speed intercept of the axisymmetric inflow "//& + "angle for the parametric idealized hurricane.", & + default=-14.33, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_AXI_INFLOW_RNORM", CS%A0_Rnorm, & + "The normalized radius dependence of the axisymmetric inflow angle "//& + "for the parametric idealized hurricane.", & + default=-0.9, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_AXI_INFLOW_MAX_SPEED", CS%A0_speed, & + "The maximum wind speed dependence of the axisymmetric inflow angle "//& + "for the parametric idealized hurricane.", & + default=-0.09, units="degrees s m-1", scale=US%L_T_to_m_s) + call get_param(param_file, mdl, "IDL_HURR_ASYM_INFLOW_0", CS%A1_0, & + "The zero-radius, zero-speed intercept of the normalized inflow angle asymmetry "//& + "for the parametric idealized hurricane.", & + default=0.14, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_ASYM_INFLOW_RNORM", CS%A1_Rnorm, & + "The normalized radius dependence of the normalized inflow angle asymmetry "//& + "for the parametric idealized hurricane.", & + default=0.04, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_ASYM_INFLOW_TR_SPEED", CS%A1_speed, & + "The translation speed dependence of the normalized inflow angle asymmetry "//& + "for the parametric idealized hurricane.", & + default=0.05, units="degrees s m-1", scale=US%L_T_to_m_s) + call get_param(param_file, mdl, "IDL_HURR_INFLOW_DANGLE_0", CS%P1_0, & + "The zero-radius, zero-speed intercept of the angle difference between the "//& + "translation direction and the inflow direction "//& + "for the parametric idealized hurricane.", & + default=85.31, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_INFLOW_DANGLE_RNORM", CS%P1_Rnorm, & + "The normalized radius dependence of the angle difference between the "//& + "translation direction and the inflow direction "//& + "for the parametric idealized hurricane.", & + default=6.88, units="degrees") + call get_param(param_file, mdl, "IDL_HURR_INFLOW_DANGLE_TR_SPEED", CS%P1_speed, & + "The translation speed dependence of the angle difference between the "//& + "translation direction and the inflow direction"//& + "for the parametric idealized hurricane.", & + default=-9.60, units="degrees s m-1", scale=US%L_T_to_m_s) + ! Parameters for SCM mode - call get_param(param_file, mdl, "IDL_HURR_SCM_BR_BENCH", CS%BR_BENCH, & + call get_param(param_file, mdl, "IDL_HURR_SCM_BR_BENCH", CS%BR_Bench, & "Single column mode benchmark case switch, which is "// & "invoking a modification (bug) in the wind profile meant to "//& "reproduce a previous implementation.", default=.false.) - call get_param(param_file, mdl, "IDL_HURR_SCM", CS%SCM_MODE, & + call get_param(param_file, mdl, "IDL_HURR_SCM", CS%SCM_mode, & "Single Column mode switch used in the SCM idealized hurricane wind profile.", & default=.false.) + call get_param(param_file, mdl, "IDL_HURR_SCM_EDGE_TAPER_BUG", CS%edge_taper_bug, & + "If true and IDL_HURR_SCM is true, use a bug that does all of the tapering and "//& + "inflow angle calculations for radii between RAD_EDGE and RAD_AMBIENT as though "//& + "they were at RAD_EDGE.", & + default=CS%SCM_mode, do_not_log=.not.CS%SCM_mode) !### Change the default to false. + if (.not.CS%SCM_mode) CS%edge_taper_bug = .false. call get_param(param_file, mdl, "IDL_HURR_SCM_LOCY", CS%dy_from_center, & - "Y distance of station used in the SCM idealized hurricane "//& - "wind profile.", units='m', default=50.e3, scale=US%m_to_L) + "Y distance of station used in the SCM idealized hurricane wind profile.", & + units='m', default=50.e3, scale=US%m_to_L) + call get_param(param_file, mdl, "IDL_HURR_SCM_CORIOLIS", CS%f_column, & + "Coriolis parameter used in the single column mode idealized hurricane wind profile.", & + units='s-1', default=5.5659e-05, scale=US%T_to_s, do_not_log=.not.CS%BR_Bench) ! (CS%SCM_mode) + 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) @@ -176,6 +264,48 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) "values use expressions that are rescalable and respect rotational symmetry.", & default=default_answer_date) + ! Parameters for the simple Cdrag expression + call get_param(param_file, mdl, "IDL_HURR_CD_CALM", CS%Cd_calm, & + "The drag coefficient with weak relative winds "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units='nondim', default=1.2e-3) + call get_param(param_file, mdl, "IDL_HURR_CD_CALM_SPEED", CS%calm_speed, & + "The relative wind speed below which the drag coefficient takes its calm value "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units='m s-1', default=11.0, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "IDL_HURR_CD_WINDY", CS%Cd_windy, & + "The drag coefficient with strong relative winds "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units='nondim', default=1.8e-3) + call get_param(param_file, mdl, "IDL_HURR_CD_WINDY_SPEED", CS%windy_speed, & + "The relative wind speed below which the drag coefficient takes its windy value "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units='m s-1', default=20.0, scale=US%m_s_to_L_T) + call get_param(param_file, mdl, "IDL_HURR_CD_CONTINUOUS", continuous_Cd, & + "If true, use a continuous form for the simple drag coefficient as a function of "//& + "wind speed with the idealized hurricane. When this is false, the linear shape "//& + "for the mid-range wind speeds is specified separately.", & + default=.false.) + call get_param(param_file, mdl, "IDL_HURR_CD_DCD_DU10", CS%dCd_dU10, & + "The partial derivative of the drag coefficient times 1000 with the 10 m wind speed "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units="s m-1", default=0.065, scale=US%L_T_to_m_s, do_not_log=continuous_Cd) + call get_param(param_file, mdl, "IDL_HURR_CD_INTERCEPT", CS%Cd_intercept, & + "The zero-wind intercept times 1000 of the linear fit for the drag coefficient "//& + "for the intermediate speeds where there is a linear dependence on the 10 m wind speed "//& + "for the simple drag coefficient expression used with the idealized hurricane.", & + units="nondim", default=0.49, do_not_log=continuous_Cd) + if (continuous_Cd) then + if (CS%windy_speed > CS%calm_speed) then + CS%dCd_dU10 = (CS%Cd_windy - CS%Cd_calm) / (CS%windy_speed - CS%calm_speed) + CS%Cd_intercept = CS%Cd_calm - CS%dCd_dU10 * CS%calm_speed + else + CS%dCd_dU10 = 0.0 + CS%Cd_intercept = CS%Cd_windy + endif + endif + + ! The following parameters are model run-time parameters which are used ! and logged elsewhere and so should not be logged here. The default ! value should be consistent with the rest of the model. @@ -189,9 +319,9 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) "The background gustiness in the winds.", & units="Pa", default=0.0, scale=US%kg_m2s_to_RZ_T*US%m_s_to_L_T, do_not_log=.true.) - if (CS%BR_BENCH) then - CS%rho_a = 1.2*US%kg_m3_to_R - endif + if (CS%rad_edge >= CS%rad_ambient) call MOM_error(FATAL, & + "idealized_hurricane_wind_init: IDL_HURR_RAD_AMBIENT must be larger than IDL_HURR_RAD_EDGE.") + dP = CS%pressure_ambient - CS%pressure_central if (CS%answer_date < 20190101) then C = CS%max_windspeed / sqrt( US%R_to_kg_m3 * dP ) @@ -199,8 +329,6 @@ subroutine idealized_hurricane_wind_init(Time, G, US, param_file, CS) else CS%Holland_B = CS%max_windspeed**2 * CS%rho_a * exp(1.0) / dP endif - CS%Holland_A = (US%L_to_m*CS%rad_max_wind)**CS%Holland_B - CS%Holland_AxBxDP = CS%Holland_A*CS%Holland_B*dP end subroutine idealized_hurricane_wind_init @@ -225,6 +353,7 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) real :: fbench !< The benchmark 'f' value [T-1 ~> s-1] real :: fbench_fac !< A factor that is set to 0 to use the !! benchmark 'f' value [nondim] + real :: km_to_L !< The conversion factor from the units of latitude to L [L km-1 ~> 1e3] real :: rel_tau_fac !< A factor that is set to 0 to disable !! current relative stress calculation [nondim] @@ -234,6 +363,8 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB + km_to_L = 1.0e3*US%m_to_L + ! Allocate the forcing arrays, if necessary. call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., tau_mag=.true.) @@ -252,7 +383,7 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) if (CS%BR_Bench) then ! f reset to value used in generated wind for benchmark test - fbench = 5.5659e-05 * US%T_to_s + fbench = CS%f_column fbench_fac = 0.0 else fbench = 0.0 @@ -267,17 +398,17 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) Vocn = 0.25*(sfc_state%v(i,J)+sfc_state%v(i+1,J-1)& +sfc_state%v(i+1,J)+sfc_state%v(i,J-1))*REL_TAU_FAC else - Vocn =0.25*((sfc_state%v(i,J)+sfc_state%v(i+1,J-1)) +& - (sfc_state%v(i+1,J)+sfc_state%v(i,J-1))) * REL_TAU_FAC + Vocn = 0.25*((sfc_state%v(i,J)+sfc_state%v(i+1,J-1)) +& + (sfc_state%v(i+1,J)+sfc_state%v(i,J-1))) * REL_TAU_FAC endif f_local = abs(0.5*(G%CoriolisBu(I,J)+G%CoriolisBu(I,J-1)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then - YY = YC + CS%dy_from_center - XX = XC + YY = CS%dy_from_center - YC + XX = -XC else - YY = G%geoLatCu(I,j)*1000.*US%m_to_L - YC - XX = G%geoLonCu(I,j)*1000.*US%m_to_L - XC + YY = G%geoLatCu(I,j)*km_to_L - YC + XX = G%geoLonCu(I,j)*km_to_L - XC endif call idealized_hurricane_wind_profile(CS, US, f_local, YY, XX, Uocn, Vocn, TX, TY) forces%taux(I,j) = G%mask2dCu(I,j) * TX @@ -297,11 +428,11 @@ subroutine idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, CS) f_local = abs(0.5*(G%CoriolisBu(I-1,J)+G%CoriolisBu(I,J)))*fbench_fac + fbench ! Calculate position as a function of time. if (CS%SCM_mode) then - YY = YC + CS%dy_from_center - XX = XC + YY = CS%dy_from_center - YC + XX = -XC else - YY = G%geoLatCv(i,J)*1000.*US%m_to_L - YC - XX = G%geoLonCv(i,J)*1000.*US%m_to_L - XC + YY = G%geoLatCv(i,J)*km_to_L - YC + XX = G%geoLonCv(i,J)*km_to_L - XC endif call idealized_hurricane_wind_profile(CS, US, f_local, YY, XX, Uocn, Vocn, TX, TY) forces%tauy(i,J) = G%mask2dCv(i,J) * TY @@ -347,30 +478,41 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx ! Wind profile terms real :: U10 ! The 10 m wind speed [L T-1 ~> m s-1] real :: radius ! The distance from the hurricane center [L ~> m] - real :: radius10 ! 10 times the distance from the hurricane center [L ~> m] + real :: radius10 ! The distance from the hurricane center to its edge [L ~> m] real :: radius_km ! The distance from the hurricane center, perhaps in km [L ~> m] or [1000 L ~> km] - real :: radiusB - real :: tmp ! A temporary variable [R L T-1 ~> kg m-2 s-1] real :: du10 ! The magnitude of the difference between the 10 m wind and the ocean flow [L T-1 ~> m s-1] real :: du ! The difference between the zonal 10 m wind and the zonal ocean flow [L T-1 ~> m s-1] real :: dv ! The difference between the meridional 10 m wind and the zonal ocean flow [L T-1 ~> m s-1] - real :: CD + real :: Cd ! The drag coefficient [nondim] + ! These variables with weird units are only used with pre-20240501 expressions + real :: radiusB ! A rescaled radius in m raised to the variable power CS%Holland_B [m^B] + real :: Holland_A ! Parameter 'A' from the Holland formula, in units of m raised to Holland_B [m^B] + real :: Holland_AxBxDP ! 'A' x 'B' x (Pressure Ambient-Pressure central) + ! for the Holland profile calculation [m^B R L2 T-2 ~> m^B Pa] + real :: tmp ! A temporary variable [m^B R L T-1 ~> m^B kg m-2 s-1] + ! These variables are used with expressions from 20240501 or later + real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa] + real :: tmpA ! A temporary variable [R L2 T-2 ~> Pa] + real :: tmpB ! A temporary variable [R L T-1 ~> kg m-2 s-1] + real :: rad_max_rad_B ! The radius of maximum wind divided by the distance from the center raised + ! to the power of Holland_B [nondim] + real :: rad_rad_max ! The radius normalized by the radius of maximum winds [nondim] !Wind angle variables - real :: Alph !< The resulting inflow angle (positive outward) - real :: Rstr - real :: A0 - real :: A1 - real :: P1 - real :: Adir + real :: Alph ! The wind inflow angle (positive outward) [radians] + real :: Rstr ! A function of the position normalized by the radius of maximum winds [nondim] + real :: A0 ! The axisymmetric inflow angle [degrees] + real :: A1 ! The inflow angle asymmetry [degrees] + real :: P1 ! The angle difference between the translation direction and the inflow direction [radians] + real :: Adir ! The angle of the direction from the center to a point [radians] real :: V_TS ! Meridional hurricane translation speed [L T-1 ~> m s-1] real :: U_TS ! Zonal hurricane translation speed [L T-1 ~> m s-1] - ! Implementing Holland (1980) parameteric wind profile + ! Implementing Holland (1980) parametric wind profile radius = SQRT(XX**2 + YY**2) + rad_rad_max = radius / CS%rad_max_wind - !/ BGR ! rkm - r converted to km for Holland prof. ! used in km due to error, correct implementation should ! not need rkm, but to match winds w/ experiment this must @@ -382,17 +524,24 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx ! if not comparing to benchmark, then use correct Holland prof. radius_km = radius endif - radiusB = (US%L_to_m*radius)**CS%Holland_B !/ - ! Calculate U10 in the interior (inside of 10x radius of maximum wind), - ! while adjusting U10 to 0 outside of 12x radius of maximum wind. + ! Calculate U10 in the interior (inside of the hurricane edge radius), + ! while adjusting U10 to 0 outside of the ambient wind radius. if (CS%answer_date < 20190101) then - if ( (radius > 0.001*CS%rad_max_wind) .and. (radius < 10.*CS%rad_max_wind) ) then - U10 = sqrt(CS%Holland_AxBxDP*exp(-CS%Holland_A/radiusB) / (CS%rho_a*radiusB) + & + radiusB = (US%L_to_m*radius)**CS%Holland_B + Holland_A = (US%L_to_m*CS%rad_max_wind)**CS%Holland_B + if ( (radius > 0.001*CS%rad_max_wind) .and. (radius < CS%rad_edge*CS%rad_max_wind) ) then + Holland_AxBxDP = Holland_A*CS%Holland_B*(CS%pressure_ambient - CS%pressure_central) + U10 = sqrt(Holland_AxBxDP*exp(-Holland_A/radiusB) / (CS%rho_a*radiusB) + & 0.25*(radius_km*absf)**2) - 0.5*radius_km*absf - elseif ( (radius > 10.*CS%rad_max_wind) .and. (radius < 15.*CS%rad_max_wind) ) then - radius10 = CS%rad_max_wind*10. + elseif ( (radius > CS%rad_edge*CS%rad_max_wind) .and. (radius < CS%rad_ambient*CS%rad_max_wind) ) then + if (CS%edge_taper_bug) then ! This recreates a bug that was in SCM_idealized_hurricane_wind_forcing. + radius = CS%rad_edge * CS%rad_max_wind + rad_rad_max = CS%rad_edge + endif + + radius10 = CS%rad_max_wind*CS%rad_edge if (CS%BR_Bench) then radius_km = radius10/1000. else @@ -400,24 +549,64 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx endif radiusB = (US%L_to_m*radius10)**CS%Holland_B - U10 = (sqrt(CS%Holland_AxBxDp*exp(-CS%Holland_A/radiusB) / (CS%rho_a*radiusB) + & + Holland_AxBxDP = Holland_A*CS%Holland_B*(CS%pressure_ambient - CS%pressure_central) + U10 = (sqrt(Holland_AxBxDp*exp(-Holland_A/radiusB) / (CS%rho_a*radiusB) + & 0.25*(radius_km*absf)**2) - 0.5*radius_km*absf) & - * (15. - radius/CS%rad_max_wind)/5. + * (CS%rad_ambient - radius/CS%rad_max_wind) / (CS%rad_ambient - CS%rad_edge) else U10 = 0. endif - else ! This is mathematically equivalent to that is above but more accurate. - if ( (radius > 0.001*CS%rad_max_wind) .and. (radius < 10.*CS%rad_max_wind) ) then + elseif (CS%answer_date < 20240501) then + ! This is mathematically equivalent to that is above but more accurate. + radiusB = (US%L_to_m*radius)**CS%Holland_B + Holland_A = (US%L_to_m*CS%rad_max_wind)**CS%Holland_B + if ( (radius > 0.001*CS%rad_max_wind) .and. (radius < CS%rad_edge*CS%rad_max_wind) ) then + Holland_AxBxDP = Holland_A*CS%Holland_B*(CS%pressure_ambient - CS%pressure_central) tmp = ( 0.5*radius_km*absf) * (CS%rho_a*radiusB) - U10 = (CS%Holland_AxBxDP * exp(-CS%Holland_A/radiusB)) / & - ( tmp + sqrt(CS%Holland_AxBxDP*exp(-CS%Holland_A/radiusB) * (CS%rho_a*radiusB) + tmp**2) ) - elseif ( (radius > 10.*CS%rad_max_wind) .and. (radius < 15.*CS%rad_max_wind) ) then - radius_km = 10.0 * CS%rad_max_wind + U10 = (Holland_AxBxDP * exp(-Holland_A/radiusB)) / & + ( tmp + sqrt(Holland_AxBxDP*exp(-Holland_A/radiusB) * (CS%rho_a*radiusB) + tmp**2) ) + elseif ( (radius > CS%rad_edge*CS%rad_max_wind) .and. (radius < CS%rad_ambient*CS%rad_max_wind) ) then + if (CS%edge_taper_bug) then ! This recreates a bug that was in SCM_idealized_hurricane_wind_forcing. + radius = CS%rad_edge * CS%rad_max_wind + rad_rad_max = CS%rad_edge + endif + + radius_km = CS%rad_edge * CS%rad_max_wind if (CS%BR_Bench) radius_km = radius_km/1000. - radiusB = (10.0*US%L_to_m*CS%rad_max_wind)**CS%Holland_B + radiusB = (CS%rad_edge*US%L_to_m*CS%rad_max_wind)**CS%Holland_B tmp = ( 0.5*radius_km*absf) * (CS%rho_a*radiusB) - U10 = (3.0 - radius/(5.0*CS%rad_max_wind)) * (CS%Holland_AxBxDp*exp(-CS%Holland_A/radiusB) ) / & - ( tmp + sqrt(CS%Holland_AxBxDp*exp(-CS%Holland_A/radiusB) * (CS%rho_a*radiusB) + tmp**2) ) + Holland_AxBxDP = Holland_A*CS%Holland_B*(CS%pressure_ambient - CS%pressure_central) + U10 = ((CS%rad_ambient/(CS%rad_ambient - CS%rad_edge)) - & + radius/((CS%rad_ambient - CS%rad_edge)*CS%rad_max_wind)) * & + (Holland_AxBxDp*exp(-Holland_A/radiusB) ) / & + ( tmp + sqrt(Holland_AxBxDp*exp(-Holland_A/radiusB) * (CS%rho_a*radiusB) + tmp**2) ) + else + U10 = 0.0 + endif + else + ! This is mathematically equivalent to the expressions above, but allows for full + ! dimensional consistency testing. + dP = CS%pressure_ambient - CS%pressure_central + if ( (rad_rad_max > 0.001) .and. (rad_rad_max <= CS%rad_edge) ) then + rad_max_rad_B = (rad_rad_max)**(-CS%Holland_B) + tmpA = (rad_max_rad_B*CS%Holland_B) * dp + tmpB = (0.5*radius_km*absf) * CS%rho_a + U10 = ( tmpA * exp(-rad_max_rad_B) ) / & + ( tmpB + sqrt( (tmpA * CS%rho_a) * exp(-rad_max_rad_B) + tmpB**2) ) + elseif ( (rad_rad_max > CS%rad_edge) .and. (rad_rad_max < CS%rad_ambient) ) then + if (CS%edge_taper_bug) then ! This recreates a bug that was in SCM_idealized_hurricane_wind_forcing. + radius = CS%rad_edge * CS%rad_max_wind + rad_rad_max = CS%rad_edge + endif + + radius_km = CS%rad_edge * CS%rad_max_wind + if (CS%BR_Bench) radius_km = radius_km * 0.001 + rad_max_rad_B = CS%rad_edge**(-CS%Holland_B) + tmpA = (rad_max_rad_B*CS%Holland_B) * dp + tmpB = (0.5*radius_km*absf) * CS%rho_a + U10 = ((CS%rad_ambient - rad_rad_max) * ( tmpA * exp(-rad_max_rad_B) )) / & + ((CS%rad_ambient - CS%rad_edge) * & + ( tmpB + sqrt((tmpA * CS%rho_a) * exp(-rad_max_rad_B) + tmpB**2) ) ) else U10 = 0.0 endif @@ -429,45 +618,42 @@ subroutine idealized_hurricane_wind_profile(CS, US, absf, YY, XX, UOCN, VOCN, Tx ! Wind angle model following Zhang and Ulhorn (2012) ! ALPH is inflow angle positive outward. - RSTR = min(10., radius / CS%rad_max_wind) - A0 = -0.9*RSTR - 0.09*US%L_T_to_m_s*CS%max_windspeed - 14.33 - A1 = -A0*(0.04*RSTR + 0.05*US%L_T_to_m_s*CS%hurr_translation_spd + 0.14) - P1 = (6.88*RSTR - 9.60*US%L_T_to_m_s*CS%hurr_translation_spd + 85.31) * CS%Deg2Rad - ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) - if ( (radius > 10.*CS%rad_max_wind) .and.& - (radius < 15.*CS%rad_max_wind) ) then - ALPH = ALPH*(15.0 - radius/CS%rad_max_wind)/5. - elseif (radius > 15.*CS%rad_max_wind) then - ALPH = 0.0 + RSTR = min(CS%rad_edge, rad_rad_max) + if (CS%answer_date < 20240501) then + A0 = CS%A0_Rnorm*RSTR + CS%A0_speed*CS%max_windspeed + CS%A0_0 + A1 = -A0*(CS%A1_Rnorm*RSTR + CS%A1_speed*CS%hurr_translation_spd + CS%A1_0) + P1 = (CS%P1_Rnorm*RSTR + CS%P1_speed*CS%hurr_translation_spd + CS%P1_0) * CS%Deg2Rad + ALPH = A0 - A1*cos(CS%hurr_translation_dir-Adir-P1) + if ( (radius > CS%rad_edge*CS%rad_max_wind) .and. (radius < CS%rad_ambient*CS%rad_max_wind) ) then + ALPH = ALPH*(CS%rad_ambient - rad_rad_max) / (CS%rad_ambient - CS%rad_edge) + elseif (radius > CS%rad_ambient*CS%rad_max_wind) then ! This should be >= to avoid a jump at CS%rad_ambient + ALPH = 0.0 + endif + ALPH = ALPH * CS%Deg2Rad + else + A0 = (CS%A0_Rnorm*RSTR + CS%A0_speed*CS%max_windspeed) + CS%A0_0 + A1 = -A0*((CS%A1_Rnorm*RSTR + CS%A1_speed*CS%hurr_translation_spd) + CS%A1_0) + P1 = ((CS%P1_Rnorm*RSTR + CS%P1_speed*CS%hurr_translation_spd) + CS%P1_0) * CS%Deg2Rad + ALPH = (A0 - A1*cos((CS%hurr_translation_dir- Adir) - P1) ) * CS%Deg2Rad + if (rad_rad_max > CS%rad_edge) & + ALPH = ALPH * (max(CS%rad_ambient - rad_rad_max, 0.0) / (CS%rad_ambient - CS%rad_edge)) endif - ALPH = ALPH * CS%Deg2Rad ! Calculate translation speed components U_TS = CS%hurr_translation_spd * 0.5*cos(CS%hurr_translation_dir) V_TS = CS%hurr_translation_spd * 0.5*sin(CS%hurr_translation_dir) ! Set output (relative) winds - dU = U10*sin(Adir-CS%Pi-Alph) - Uocn + U_TS + dU = U10*sin(Adir-CS%pi-Alph) - Uocn + U_TS dV = U10*cos(Adir-Alph) - Vocn + V_TS ! Use a simple drag coefficient as a function of U10 (from Sullivan et al., 2010) du10 = sqrt(du**2+dv**2) - if (dU10 < 11.0*US%m_s_to_L_T) then - Cd = 1.2e-3 - elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answer_date < 20190101) then - Cd = (0.49 + 0.065*US%L_T_to_m_s*U10)*1.e-3 - else - Cd = (0.49 + 0.065*US%L_T_to_m_s*dU10)*1.e-3 - endif - else - Cd = 1.8e-3 - endif + Cd = simple_wind_scaled_Cd(u10, du10, CS) ! Compute stress vector - TX = US%L_to_Z * CS%rho_a * Cd * sqrt(dU**2 + dV**2) * dU - TY = US%L_to_Z * CS%rho_a * Cd * sqrt(dU**2 + dV**2) * dV - + TX = US%L_to_Z * CS%rho_a * Cd * du10 * dU + TY = US%L_to_Z * CS%rho_a * Cd * du10 * dV end subroutine idealized_hurricane_wind_profile !> This subroutine is primarily needed as a legacy for reproducing answers. @@ -484,24 +670,34 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ! Local variables integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB - real :: pie, Deg2Rad real :: du10 ! The magnitude of the difference between the 10 m wind and the ocean flow [L T-1 ~> m s-1] real :: U10 ! The 10 m wind speed [L T-1 ~> m s-1] - real :: A, B, C ! For wind profile expression + real :: A ! The radius of the maximum winds raised to the power given by B, used in the + ! wind profile expression, in [km^B] + real :: B ! A power used in the wind profile expression [nondim] + real :: C ! A temporary variable in units of the square root of a specific volume [sqrt(m3 kg-1)] real :: rad ! The distance from the hurricane center [L ~> m] + real :: radius10 ! The distance from the hurricane center to its edge [L ~> m] real :: rkm ! The distance from the hurricane center, sometimes scaled to km [L ~> m] or [1000 L ~> km] real :: f_local ! The local Coriolis parameter [T-1 ~> s-1] real :: xx ! x-position [L ~> m] - real :: t0 !for location + real :: t0 ! Time at which the eye crosses the origin [T ~> s] real :: dP ! The pressure difference across the hurricane [R L2 T-2 ~> Pa] - real :: rB - real :: Cd ! Air-sea drag coefficient + real :: rB ! The distance from the center raised to the power given by B, in [m^B] + ! or [km^B] if BR_Bench is true. + real :: Cd ! Air-sea drag coefficient [nondim] real :: Uocn, Vocn ! Surface ocean velocity components [L T-1 ~> m s-1] real :: dU, dV ! Air-sea differential motion [L T-1 ~> m s-1] - !Wind angle variables - real :: Alph,Rstr, A0, A1, P1, Adir, transdir + ! Wind angle variables + real :: Alph ! The wind inflow angle (positive outward) [radians] + real :: Rstr ! A function of the position normalized by the radius of maximum winds [nondim] + real :: A0 ! The axisymmetric inflow angle [degrees] + real :: A1 ! The inflow angle asymmetry [degrees] + real :: P1 ! The angle difference between the translation direction and the inflow direction [radians] + real :: Adir ! The angle of the direction from the center to a point [radians] + real :: transdir ! Translation direction [radians] real :: V_TS, U_TS ! Components of the translation speed [L T-1 ~> m s-1] - logical :: BR_Bench + ! Bounds for loops and memory allocation is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -509,46 +705,46 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! Allocate the forcing arrays, if necessary. - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., tau_mag=.true.) - pie = 4.0*atan(1.0) ; Deg2Rad = pie/180. - !/ BR + ! Implementing Holland (1980) parameteric wind profile - !------------------------------------------------------| - BR_Bench = .true. !true if comparing to LES runs | - t0 = 129600. !TC 'eye' crosses (0,0) at 36 hours| - transdir = pie !translation direction (-x) | - !------------------------------------------------------| + !------------------------------------------------------------| + t0 = 129600.*US%s_to_T ! TC 'eye' crosses (0,0) at 36 hours | + transdir = CS%pi ! translation direction (-x) | + !------------------------------------------------------------| dP = CS%pressure_ambient - CS%pressure_central if (CS%answer_date < 20190101) then C = CS%max_windspeed / sqrt( US%R_to_kg_m3*dP ) B = C**2 * US%R_to_kg_m3*CS%rho_a * exp(1.0) - if (BR_Bench) then ! rho_a reset to value used in generated wind for benchmark test + if (CS%BR_Bench) then ! rho_a reset to value used in generated wind for benchmark test B = C**2 * 1.2 * exp(1.0) endif - elseif (BR_Bench) then ! rho_a reset to value used in generated wind for benchmark test - B = (CS%max_windspeed**2 / dP ) * 1.2*US%kg_m3_to_R * exp(1.0) else - B = (CS%max_windspeed**2 /dP ) * CS%rho_a * exp(1.0) + B = (CS%max_windspeed**2 / dP ) * CS%rho_a * exp(1.0) endif - A = (US%L_to_m*CS%rad_max_wind / 1000.)**B - f_local = G%CoriolisBu(is,js) ! f=f(x,y) but in the SCM is constant - if (BR_Bench) then - ! f reset to value used in generated wind for benchmark test - f_local = 5.5659e-05*US%T_to_s + if (CS%BR_Bench) then + A = (US%L_to_m*CS%rad_max_wind / 1000.)**B + else + A = (US%L_to_m*CS%rad_max_wind)**B + endif + ! f_local = f(x,y), but in the SCM it is constant + if (CS%BR_Bench) then ! (CS%SCM_mode) then + f_local = CS%f_column + else + f_local = G%CoriolisBu(is,js) endif - !/ BR - ! Calculate x position as a function of time. - xx = US%s_to_T*( t0 - time_type_to_real(day)) * CS%hurr_translation_spd * cos(transdir) + + ! Calculate x position relative to hurricane center as a function of time. + xx = (t0 - time_type_to_real(day)*US%s_to_T) * CS%hurr_translation_spd * cos(transdir) rad = sqrt(xx**2 + CS%dy_from_center**2) - !/ BR + ! rkm - rad converted to km for Holland prof. ! used in km due to error, correct implementation should ! not need rkm, but to match winds w/ experiment this must ! be maintained. Causes winds far from storm center to be a ! couple of m/s higher than the correct Holland prof. - if (BR_Bench) then + if (CS%BR_Bench) then rkm = rad/1000. rB = (US%L_to_m*rkm)**B else @@ -556,43 +752,42 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C rkm = rad rB = (US%L_to_m*rad)**B endif - !/ BR - ! Calculate U10 in the interior (inside of 10x radius of maximum wind), - ! while adjusting U10 to 0 outside of 12x radius of maximum wind. - ! Note that rho_a is set to 1.2 following generated wind for experiment - if (rad > 0.001*CS%rad_max_wind .AND. rad < 10.*CS%rad_max_wind) then - U10 = sqrt( A*B*dP*exp(-A/rB)/(1.2*US%kg_m3_to_R*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local - elseif (rad > 10.*CS%rad_max_wind .AND. rad < 12.*CS%rad_max_wind) then - rad=(CS%rad_max_wind)*10. - if (BR_Bench) then - rkm = rad/1000. + + ! Calculate U10 in the interior (inside of the hurricane edge radius), + ! while adjusting U10 to 0 outside of the ambient wind radius. + if (rad > 0.001*CS%rad_max_wind .AND. rad < CS%rad_edge*CS%rad_max_wind) then + U10 = sqrt( A*B*dP*exp(-A/rB)/(CS%rho_a*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local + elseif (rad > CS%rad_edge*CS%rad_max_wind .AND. rad < CS%rad_ambient*CS%rad_max_wind) then + radius10 = CS%rad_max_wind*CS%rad_edge + if (CS%BR_Bench) then + rkm = radius10/1000. rB = (US%L_to_m*rkm)**B else - rkm = rad - rB = (US%L_to_m*rad)**B + rkm = radius10 + rB = (US%L_to_m*radius10)**B endif - U10 = ( sqrt( A*B*dP*exp(-A/rB)/(1.2*US%kg_m3_to_R*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local) & - * (12. - rad/CS%rad_max_wind)/2. + if (CS%edge_taper_bug) rad = radius10 + U10 = ( sqrt( A*B*dP*exp(-A/rB)/(CS%rho_a*rB) + 0.25*(rkm*f_local)**2 ) - 0.5*rkm*f_local) & + * (CS%rad_ambient - rad/CS%rad_max_wind)/(CS%rad_ambient - CS%rad_edge) else U10 = 0. endif Adir = atan2(CS%dy_from_center,xx) - !/ BR ! Wind angle model following Zhang and Ulhorn (2012) ! ALPH is inflow angle positive outward. - RSTR = min(10., rad / CS%rad_max_wind) - A0 = -0.9*RSTR - 0.09*US%L_T_to_m_s*CS%max_windspeed - 14.33 - A1 = -A0 *(0.04*RSTR + 0.05*US%L_T_to_m_s*CS%hurr_translation_spd + 0.14) - P1 = (6.88*RSTR - 9.60*US%L_T_to_m_s*CS%hurr_translation_spd + 85.31)*pie/180. + RSTR = min(CS%rad_edge, rad / CS%rad_max_wind) + A0 = CS%A0_Rnorm*RSTR + CS%A0_speed*CS%max_windspeed + CS%A0_0 + A1 = -A0*(CS%A1_Rnorm*RSTR + CS%A1_speed*CS%hurr_translation_spd + CS%A1_0) + P1 = (CS%P1_Rnorm*RSTR + CS%P1_speed*CS%hurr_translation_spd + CS%P1_0) * CS%pi/180. ALPH = A0 - A1*cos( (TRANSDIR - ADIR ) - P1) - if (rad > 10.*CS%rad_max_wind .AND. rad < 12.*CS%rad_max_wind) then - ALPH = ALPH* (12. - rad/CS%rad_max_wind)/2. - elseif (rad > 12.*CS%rad_max_wind) then + if (rad > CS%rad_edge*CS%rad_max_wind .AND. rad < CS%rad_ambient*CS%rad_max_wind) then + ALPH = ALPH* (CS%rad_ambient - rad/CS%rad_max_wind) / (CS%rad_ambient - CS%rad_edge) + elseif (rad > CS%rad_ambient*CS%rad_max_wind) then ALPH = 0.0 endif - ALPH = ALPH * Deg2Rad - !/BR + ALPH = ALPH * CS%Deg2Rad + ! Prepare for wind calculation ! X_TS is component of translation speed added to wind vector ! due to background steering wind. @@ -604,55 +799,33 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C ! The i-loop extends to is-1 so that taux can be used later in the ! calculation of ustar - otherwise the lower bound would be Isq. do j=js,je ; do I=is-1,Ieq - !/BR ! Turn off surface current for stress calculation to be ! consistent with test case. Uocn = 0. ! sfc_state%u(I,j) Vocn = 0. ! 0.25*( (sfc_state%v(i,J) + sfc_state%v(i+1,J-1)) + & ! (sfc_state%v(i+1,J) + sfc_state%v(i,J-1)) ) - !/BR ! Wind vector calculated from location/direction (sin/cos flipped b/c ! cyclonic wind is 90 deg. phase shifted from position angle). - dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS - dV = U10*cos(Adir-Alph) - Vocn + V_TS + dU = U10*sin(Adir - CS%pi - Alph) - Uocn + U_TS + dV = U10*cos(Adir - Alph) - Vocn + V_TS !/----------------------------------------------------| - !BR ! Add a simple drag coefficient as a function of U10 | !/----------------------------------------------------| du10 = sqrt(du**2+dv**2) - if (dU10 < 11.0*US%m_s_to_L_T) then - Cd = 1.2e-3 - elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answer_date < 20190101) then - Cd = (0.49 + 0.065 * US%L_T_to_m_s*U10 )*0.001 - else - Cd = (0.49 + 0.065 * US%L_T_to_m_s*dU10 )*0.001 - endif - else - Cd = 0.0018 - endif + Cd = simple_wind_scaled_Cd(u10, du10, CS) + forces%taux(I,j) = CS%rho_a * US%L_to_Z * G%mask2dCu(I,j) * Cd*du10*dU enddo ; enddo - !/BR + ! See notes above do J=js-1,Jeq ; do i=is,ie Uocn = 0. ! 0.25*( (sfc_state%u(I,j) + sfc_state%u(I-1,j+1)) + & ! (sfc_state%u(I-1,j) + sfc_state%u(I,j+1)) ) Vocn = 0. ! sfc_state%v(i,J) - dU = U10*sin(Adir-pie-Alph) - Uocn + U_TS + dU = U10*sin(Adir - CS%pi - Alph) - Uocn + U_TS dV = U10*cos(Adir-Alph) - Vocn + V_TS - du10=sqrt(du**2+dv**2) - if (dU10 < 11.0*US%m_s_to_L_T) then - Cd = 1.2e-3 - elseif (dU10 < 20.0*US%m_s_to_L_T) then - if (CS%answer_date < 20190101) then - Cd = (0.49 + 0.065 * US%L_T_to_m_s*U10 )*0.001 - else - Cd = (0.49 + 0.065 * US%L_T_to_m_s*dU10 )*0.001 - endif - else - Cd = 0.0018 - endif + du10 = sqrt(du**2+dv**2) + Cd = simple_wind_scaled_Cd(u10, du10, CS) forces%tauy(I,j) = CS%rho_a * US%L_to_Z * G%mask2dCv(I,j) * Cd*dU10*dV enddo ; enddo @@ -673,4 +846,27 @@ subroutine SCM_idealized_hurricane_wind_forcing(sfc_state, forces, day, G, US, C end subroutine SCM_idealized_hurricane_wind_forcing +!> This function returns the air-sea drag coefficient using a simple function of the air-sea velocity difference. +function simple_wind_scaled_Cd(u10, du10, CS) result(Cd) + real, intent(in) :: U10 !< The 10 m wind speed [L T-1 ~> m s-1] + real, intent(in) :: du10 !< The magnitude of the difference between the 10 m wind + !! and the ocean flow [L T-1 ~> m s-1] + type(idealized_hurricane_CS), pointer :: CS !< Container for SCM parameters + real :: Cd ! Air-sea drag coefficient [nondim] + + ! Note that these expressions are discontinuous at dU10 = 11 and 20 m s-1. + if (dU10 < CS%calm_speed) then + Cd = CS%Cd_calm + elseif (dU10 < CS%windy_speed) then + if (CS%answer_date < 20190101) then + Cd = (CS%Cd_intercept + CS%dCd_dU10 * U10 )*0.001 + else + Cd = (CS%Cd_intercept + CS%dCd_dU10 * dU10 )*0.001 + endif + else + Cd = CS%Cd_windy + endif + +end function simple_wind_scaled_Cd + end module idealized_hurricane From 9059671be5e4fa5e2fbe314609a0cc3f0592e164 Mon Sep 17 00:00:00 2001 From: Theresa Morrison <114184229+theresa-morrison@users.noreply.github.com> Date: Mon, 3 Jun 2024 09:33:36 -0400 Subject: [PATCH 20/21] Add rescaling parameter to kappa shear (#643) * Add rescaling paramter to KD Shear Add a parameted (beta) to rescale the distance to the nearest solid boundary that is used within calculation of kappa shear. While rescaling this value is unphysical, this adjustment can be thought of as not allowing shear instabilities to grow up to the full distance to the nearest boundary because of other turbulent processes which would disrupt their growth. * Rename parameter and swtich to multiplication Rename the parameter beta to lz_rescale to be more descriptive. To avoid two divisions in a single line, the inverse of lz_rescale is calculated and stored as I_lz_rescale_sqr. Where the calculation is done logic has been added to check that lz_rescale is greater than zero to avoid dividing by zero or making lz_rescale negative. * Add Comment where lz_rescale is used Based on Wei's suggestion, add a comment where lz_rescale is used and put the multiplication by I_lz_rescale to the next line. * Remove Trailing whitespace --------- Co-authored-by: Theresa Morrison Co-authored-by: Theresa Morrison Co-authored-by: Theresa Morrison Co-authored-by: Theresa Morrison --- .../vertical/MOM_kappa_shear.F90 | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index 8a1974d8ea..dac8508b4d 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -54,6 +54,10 @@ module MOM_kappa_shear real :: lambda2_N_S !< The square of the ratio of the coefficients of !! the buoyancy and shear scales in the diffusivity !! equation, 0 to eliminate the shear scale [nondim]. + real :: lz_rescale !< A coefficient to rescale the distance to the nearest + !! solid boundary. This adjustment is to account for + !! regions where 3 dimensional turbulence prevents the + !! growth of shear instabilies [nondim]. real :: TKE_bg !< The background level of TKE [Z2 T-2 ~> m2 s-2]. real :: kappa_0 !< The background diapycnal diffusivity [H Z T-1 ~> m2 s-1 or Pa s] real :: kappa_seed !< A moderately large seed value of diapycnal diffusivity that @@ -746,6 +750,7 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, hlay, dz_la real :: wt_b ! The fraction of a layer thickness identified with the interface ! below a layer [nondim] real :: k0dt ! The background diffusivity times the timestep [H Z ~> m2 or kg m-1]. + real :: I_lz_rescale_sqr ! The inverse of a rescaling factor for L2_bdry (Lz) squared [nondim]. logical :: valid_dt ! If true, all levels so far exhibit acceptably small changes in k_src. logical :: use_temperature ! If true, temperature and salinity have been ! allocated and are being used as state variables. @@ -764,6 +769,8 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, hlay, dz_la g_R0 = (US%L_to_Z**2 * GV%g_Earth) / GV%Rho0 k0dt = dt*CS%kappa_0 + I_lz_rescale_sqr = 1.0; if (CS%lz_rescale > 0) I_lz_rescale_sqr = 1/(CS%lz_rescale*CS%lz_rescale) + tol_dksrc = CS%kappa_src_max_chg if (tol_dksrc == 10.0) then ! This is equivalent to the expression below, but avoids changes at roundoff for the default value. @@ -794,8 +801,11 @@ subroutine kappa_shear_column(kappa, tke, dt, nzc, f2, surface_pres, hlay, dz_la do K=nzc,2,-1 dist_from_bot = dist_from_bot + dz_lay(k) h_from_bot = h_from_bot + hlay(k) + ! Find the inverse of the squared distances from the boundaries, I_L2_bdry(K) = ((dist_from_top(K) + dist_from_bot) * (h_from_top(K) + h_from_bot)) / & ((dist_from_top(K) * dist_from_bot) * (h_from_top(K) * h_from_bot)) + ! reduce the distance by a factor of "lz_rescale" + I_L2_bdry(K) = I_lz_rescale_sqr*I_L2_bdry(K) enddo ! Determine the velocities and thicknesses after eliminating massless @@ -1918,6 +1928,11 @@ function kappa_shear_init(Time, G, GV, US, param_file, diag, CS) "Set this to 0 (the default) to eliminate the shear scale. "//& "This is only used if USE_JACKSON_PARAM is true.", & units="nondim", default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "LZ_RESCALE", CS%lz_rescale, & + "A coefficient to rescale the distance to the nearest solid boundary. "//& + "This adjustment is to account for regions where 3 dimensional turbulence "//& + "prevents the growth of shear instabilies [nondim].", & + units="nondim", default=1.0) call get_param(param_file, mdl, "KAPPA_SHEAR_TOL_ERR", CS%kappa_tol_err, & "The fractional error in kappa that is tolerated. "//& "Iteration stops when changes between subsequent "//& From f0badc6b6586d9f67bb38e4d10087856a222076e Mon Sep 17 00:00:00 2001 From: yichengt900 Date: Tue, 28 May 2024 21:36:05 -0400 Subject: [PATCH 21/21] Prestore axes_data in set_up_ALE_sponge_field fix style errors Modify axes_data to make it allocatable fix style --- src/framework/MOM_horizontal_regridding.F90 | 15 +++++++++++++-- src/parameterizations/vertical/MOM_ALE_sponge.F90 | 14 ++++++++------ 2 files changed, 21 insertions(+), 8 deletions(-) diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index ce739cba55..1d5eab106d 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -627,7 +627,8 @@ end subroutine horiz_interp_and_extrap_tracer_record subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, & z_in, z_edges_in, missing_value, scale, & homogenize, spongeOngrid, m_to_Z, & - answers_2018, tr_iter_tol, answer_date) + answers_2018, tr_iter_tol, answer_date, & + axes) type(external_field), intent(in) :: field !< Handle for the time interpolated field type(time_type), intent(in) :: Time !< A FMS time type @@ -663,6 +664,7 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, & !! Dates before 20190101 give the same answers !! as the code did in late 2018, while later versions !! add parentheses for rotational symmetry. + type(axis_info), allocatable, dimension(:), optional, intent(inout) :: axes !< Axis types for the input data ! Local variables ! In the following comments, [A] is used to indicate the arbitrary, possibly rescaled units of the @@ -742,7 +744,16 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(field, Time, G, tr_z, mask_z, & call cpu_clock_begin(id_clock_read) - call get_external_field_info(field, size=fld_sz, axes=axes_data, missing=missing_val_in) + if (present(axes) .and. allocated(axes)) then + call get_external_field_info(field, size=fld_sz, missing=missing_val_in) + axes_data = axes + else + call get_external_field_info(field, size=fld_sz, axes=axes_data, missing=missing_val_in) + if (present(axes)) then + allocate(axes(4)) + axes = axes_data + endif + endif missing_value = scale*missing_val_in verbosity = MOM_get_verbosity() diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 0f4b50237e..f1739485d6 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -23,6 +23,7 @@ module MOM_ALE_sponge use MOM_horizontal_regridding, only : horiz_interp_and_extrap_tracer use MOM_interpolate, only : init_external_field, get_external_field_info, time_interp_external_init use MOM_interpolate, only : external_field +use MOM_io, only : axis_info use MOM_remapping, only : remapping_cs, remapping_core_h, initialize_remapping use MOM_spatial_means, only : global_i_mean use MOM_time_manager, only : time_type @@ -86,6 +87,7 @@ module MOM_ALE_sponge 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 + type(axis_info), allocatable :: axes_data(:) !< Axis types for the input field end type p2d !> ALE sponge control structure @@ -770,7 +772,7 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, 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)%field, size=fld_sz) + call get_external_field_info(CS%Ref_val(CS%fldno)%field, size=fld_sz, axes=CS%Ref_val(CS%fldno)%axes_data) nz_data = fld_sz(3) CS%Ref_val(CS%fldno)%nz_data = nz_data !< individual sponge fields may reside on a different vertical grid CS%Ref_val(CS%fldno)%num_tlevs = fld_sz(4) @@ -868,7 +870,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename CS%Ref_val_u%field = init_external_field(filename_u, fieldname_u) endif fld_sz(1:4) = -1 - call get_external_field_info(CS%Ref_val_u%field, size=fld_sz) + call get_external_field_info(CS%Ref_val_u%field, size=fld_sz, axes=CS%Ref_val_u%axes_data) CS%Ref_val_u%nz_data = fld_sz(3) CS%Ref_val_u%num_tlevs = fld_sz(4) CS%Ref_val_u%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_u%scale = scale @@ -879,7 +881,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename CS%Ref_val_v%field = init_external_field(filename_v, fieldname_v) endif fld_sz(1:4) = -1 - call get_external_field_info(CS%Ref_val_v%field, size=fld_sz) + call get_external_field_info(CS%Ref_val_v%field, size=fld_sz, axes=CS%Ref_val_v%axes_data) CS%Ref_val_v%nz_data = fld_sz(3) CS%Ref_val_v%num_tlevs = fld_sz(4) CS%Ref_val_v%scale = US%m_s_to_L_T ; if (present(scale)) CS%Ref_val_v%scale = scale @@ -963,7 +965,7 @@ subroutine apply_ALE_sponge(h, tv, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val(m)%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val(m)%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & - answer_date=CS%hor_regrid_answer_date) + answer_date=CS%hor_regrid_answer_date, axes=CS%Ref_val(m)%axes_data) allocate( dz_src(nz_data) ) allocate( tmpT1d(nz_data) ) do c=1,CS%num_col @@ -1053,7 +1055,7 @@ subroutine apply_ALE_sponge(h, tv, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val_u%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val_u%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z, & - answer_date=CS%hor_regrid_answer_date) + answer_date=CS%hor_regrid_answer_date, axes=CS%Ref_val_u%axes_data) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc-1, G%jsc:G%jec, :) = 0. @@ -1101,7 +1103,7 @@ subroutine apply_ALE_sponge(h, tv, dt, G, GV, US, CS, Time) call horiz_interp_and_extrap_tracer(CS%Ref_val_v%field, Time, G, sp_val, & mask_z, z_in, z_edges_in, missing_value, & scale=CS%Ref_val_v%scale, spongeOnGrid=CS%SpongeDataOngrid, m_to_Z=US%m_to_Z,& - answer_date=CS%hor_regrid_answer_date) + answer_date=CS%hor_regrid_answer_date, axes=CS%Ref_val_v%axes_data) ! Initialize mask_z halos to zero before pass_var, in case of no update mask_z(G%isc:G%iec, G%jsc-1, :) = 0. mask_z(G%isc:G%iec, G%jec+1, :) = 0.