diff --git a/.github/copilot-instructions.md b/.github/copilot-instructions.md new file mode 100644 index 0000000000..67caa10a62 --- /dev/null +++ b/.github/copilot-instructions.md @@ -0,0 +1 @@ +Read and follow the instructions in [docs/AGENTS.md](../docs/AGENTS.md). diff --git a/AGENTS.md b/AGENTS.md new file mode 100644 index 0000000000..148d55e588 --- /dev/null +++ b/AGENTS.md @@ -0,0 +1 @@ +Read and follow the instructions in [docs/AGENTS.md](docs/AGENTS.md). diff --git a/CLAUDE.md b/CLAUDE.md new file mode 100644 index 0000000000..6e5a268f2d --- /dev/null +++ b/CLAUDE.md @@ -0,0 +1 @@ +@docs/AGENTS.md diff --git a/README.md b/README.md index 17b0a3661c..63beca91cc 100644 --- a/README.md +++ b/README.md @@ -3,14 +3,28 @@ # MOM6 -This is the MOM6 source code. +MOM6 (Modular Ocean Model, version 6) is a next-generation open-development-source ocean model developed by a consortium of institutions. It uses a modern Fortran codebase solving the primitive equations for ocean dynamics on an Arakawa C-grid. +- Arbitrary Lagrangian-Eulerian (ALE) vertical coordinate +- Boussinesq and non-Boussinesq modes +- Flexible equation of state (Wright, TEOS-10, linear, Roquet (TEOS-10), ...) +- Comprehensive parameterization library (ePBL, KPP, lateral mixing, tidal forcing) +- Coupled to SIS2 or CICE (sea ice), ice shelves, and Earth system models via the FMS or NUOPC couplers, or run in stand-alone ocean-only configurations +- Dimensional unit scaling for consistency testing -# Where to find information -Start at the [MOM6-examples wiki](https://github.com/NOAA-GFDL/MOM6-examples/wiki) which has installation instructions. +# Where to find information -[Source code documentation](http://mom6.readthedocs.io/) is hosted on read the docs. +- [MOM6-examples wiki](https://github.com/NOAA-GFDL/MOM6-examples/wiki) -- installation instructions and tutorials +- [Source code documentation](https://mom6.readthedocs.io/en/main/) -- hosted on Read the Docs +- [Developers wiki](https://github.com/NOAA-GFDL/MOM6/wiki) -- developer guides and conventions +- [Developer workflow](https://github.com/NOAA-GFDL/MOM6/wiki/Developer-workflow) +- [Runtime parameter system](https://github.com/NOAA-GFDL/MOM6/wiki/MOM6-run-time-parameter-system) +- [Repository policies](https://github.com/NOAA-GFDL/MOM6-examples/wiki/MOM6-repository-policies) +- [MOM6 forum](https://bb.cgd.ucar.edu/cesm/forums/mom6.148/) +- [CVMix](https://github.com/CVMix/CVMix-src) -- Community Vertical Mixing +- [TEOS-10 (GSW)](http://www.teos-10.org/) -- Gibbs Seawater +- [GOTM](https://gotm.net/) -- General Ocean Turbulence Model # What files are what diff --git a/config_src/drivers/nuopc_cap/mom_cap.F90 b/config_src/drivers/nuopc_cap/mom_cap.F90 index a22fb3534b..ae78956182 100644 --- a/config_src/drivers/nuopc_cap/mom_cap.F90 +++ b/config_src/drivers/nuopc_cap/mom_cap.F90 @@ -8,6 +8,7 @@ module MOM_cap_mod use MOM_domains, only: get_domain_extent use MOM_io, only: stdout, io_infra_end +use MOM_io, only: insert_ensemble_appendix use mpp_domains_mod, only: mpp_get_compute_domains use mpp_domains_mod, only: mpp_get_ntile_count, mpp_get_pelist, mpp_get_global_domain use mpp_domains_mod, only: mpp_get_domain_npes @@ -28,6 +29,7 @@ module MOM_cap_mod use MOM_ocean_model_nuopc, only: ocean_model_init_sfc, ocean_model_flux_init use MOM_ocean_model_nuopc, only: ocean_model_init, update_ocean_model, ocean_model_end use MOM_ocean_model_nuopc, only: get_ocean_grid, get_eps_omesh, query_ocean_state +use MOM_ocean_model_nuopc, only: stoch_restart_needed use MOM_cap_time, only: AlarmInit use MOM_cap_methods, only: mom_import, mom_export, mom_set_geomtype, mod2med_areacor use MOM_cap_methods, only: med2mod_areacor, state_diagnose @@ -1775,7 +1777,7 @@ subroutine ModelAdvance(gcomp, rc) character(240) :: msgString character(ESMF_MAXSTR) :: casename integer :: iostat - integer :: writeunit + integer :: rpointer_unit type(ESMF_VM) :: vm integer :: n, i character(240) :: import_timestr, export_timestr @@ -1994,25 +1996,27 @@ subroutine ModelAdvance(gcomp, rc) rpointer_filename = trim(rpointer_filename//timestamp) endif - write(restartname,'(A,".mom6.r",A)') & - trim(casename), timestamp + write(restartname,'(A,".mom6.r",A)') trim(casename), timestamp + write(stoch_restartname,'(A,".mom6.r_stoch",A,".nc")') trim(casename), timestamp + + call insert_ensemble_appendix(stoch_restartname, ".mom6") + call ESMF_LogWrite("MOM_cap: Writing restart : "//trim(restartname), ESMF_LOGMSG_INFO) ! write restart file(s) - call ocean_model_restart(ocean_state, restartname=restartname, num_rest_files=num_rest_files) + call ocean_model_restart(ocean_state, restartname=restartname, & + stoch_restartname=stoch_restartname, num_rest_files=num_rest_files) if (localPet == 0) then ! Write name of restart file in the rpointer file - this is currently hard-coded for the ocean - open(newunit=writeunit, file=rpointer_filename, form='formatted', status='unknown', iostat=iostat) + open(newunit=rpointer_unit, file=rpointer_filename, form='formatted', status='unknown', iostat=iostat) if (iostat /= 0) then call ESMF_LogSetError(ESMF_RC_FILE_OPEN, & msg=subname//' ERROR opening '//rpointer_filename, line=__LINE__, file=u_FILE_u, rcToReturn=rc) return endif - if (len_trim(inst_suffix) == 0) then - write(writeunit,'(a)') trim(restartname)//'.nc' - else - write(writeunit,'(a)') trim(restartname)//'.'//trim(inst_suffix)//'.nc' - endif + call insert_ensemble_appendix(restartname, ".mom6") + + write(rpointer_unit,'(a)') trim(restartname)//'.nc' if (num_rest_files > 1) then ! append i.th restart file name to rpointer do i=1, num_rest_files-1 @@ -2021,10 +2025,15 @@ subroutine ModelAdvance(gcomp, rc) else write(suffix,'("_",I2)') i endif - write(writeunit,'(a)') trim(restartname) // trim(suffix) // '.nc' + write(rpointer_unit,'(a)') trim(restartname) // trim(suffix) // '.nc' enddo endif - close(writeunit) + + if (stoch_restart_needed(ocean_state)) then + write(rpointer_unit,'(a)') trim(stoch_restartname) + endif + + close(rpointer_unit) endif else ! not cesm_coupled write(restartname,'(i4.4,2(i2.2),A,3(i2.2),A)') year, month, day,".", hour, minute, seconds, & @@ -2035,7 +2044,7 @@ subroutine ModelAdvance(gcomp, rc) ! write restart file(s) call ocean_model_restart(ocean_state, restartname=restartname, & - stoch_restartname=stoch_restartname, num_rest_files=num_rest_files) + stoch_restartname='RESTART/'//stoch_restartname, num_rest_files=num_rest_files) call outputlog_restart(clock, num_rest_files, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return @@ -2091,6 +2100,7 @@ subroutine ModelSetRunClock(gcomp, rc) type(ESMF_Clock) :: mclock, dclock type(ESMF_Time) :: mcurrtime, dcurrtime type(ESMF_Time) :: mstoptime, dstoptime + type(ESMF_Time) :: mstoptime_prev ! model stop time before it is updated by this routine type(ESMF_TimeInterval) :: mtimestep, dtimestep character(len=128) :: mtimestring, dtimestring character(len=256) :: cvalue @@ -2118,7 +2128,8 @@ subroutine ModelSetRunClock(gcomp, rc) stopTime=dstoptime, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, rc=rc) + call ESMF_ClockGet(mclock, currTime=mcurrtime, timeStep=mtimestep, & + stopTime=mstoptime_prev, rc=rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return !-------------------------------- @@ -2242,12 +2253,21 @@ subroutine ModelSetRunClock(gcomp, rc) endif ! create a 1-shot alarm at the driver stop time - stop_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "stop_alarm", rc=rc) - call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO) - if (ChkErr(rc,__LINE__,u_FILE_u)) return + if (cesm_coupled) then + stop_alarm = ESMF_AlarmCreate(mclock, ringtime=mstoptime_prev, name = "stop_alarm", rc=rc) + call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return - call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) - call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) + call ESMF_TimeGet(mstoptime_prev, timestring=timestr, rc=rc) + call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) + else + stop_alarm = ESMF_AlarmCreate(mclock, ringtime=dstopTime, name = "stop_alarm", rc=rc) + call ESMF_LogWrite(subname//" Create Stop alarm", ESMF_LOGMSG_INFO) + if (ChkErr(rc,__LINE__,u_FILE_u)) return + + call ESMF_TimeGet(dstoptime, timestring=timestr, rc=rc) + call ESMF_LogWrite("Stop Alarm will ring at : "//trim(timestr), ESMF_LOGMSG_INFO) + endif call outputlog_init(gcomp, mclock, rc) if (ChkErr(rc,__LINE__,u_FILE_u)) return diff --git a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 index 96a49348cc..b808228d2a 100644 --- a/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_ocean_model_nuopc.F90 @@ -24,7 +24,7 @@ module MOM_ocean_model_nuopc use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe, MOM_mesg use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type use MOM_forcing_type, only : allocate_forcing_type @@ -64,6 +64,7 @@ module MOM_ocean_model_nuopc use MOM_surface_forcing_nuopc, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing_nuopc, only : forcing_save_restart use get_stochy_pattern_mod, only : write_stoch_restart_ocn +use stochy_data_mod, only : stoch_restfile use iso_fortran_env, only : int64 #include @@ -83,6 +84,7 @@ module MOM_ocean_model_nuopc public ocean_public_type_chksum public get_ocean_grid, query_ocean_state public get_eps_omesh +public stoch_restart_needed !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence @@ -180,11 +182,12 @@ module MOM_ocean_model_nuopc !! steps can span multiple coupled time steps. logical :: diabatic_first !< If true, apply diabatic and thermodynamic !! processes before time stepping the dynamics. - logical :: do_sppt !< If true, stochastically perturb the diabatic and - !! write restarts - logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and - !! genration termsand write restarts - + logical :: do_sppt !< If true, stochastically perturb the diabatic + !! tendencies and write restarts + logical :: pert_epbl !< If true, then randomly perturb the KE dissipation and + !! generation terms and write restarts + logical :: do_skeb !< If true, stochastically perturb the ocean lateral + !! velocity and write restarts real :: eps_omesh !< Max allowable difference between ESMF mesh and MOM6 !! domain coordinates @@ -268,6 +271,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature + integer :: i, k call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -283,6 +287,16 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call time_interp_external_init OS%Time = Time_in + if (present(input_restart_file)) then + k = index(input_restart_file, ' ') + if (k==0) k = len_trim(input_restart_file) + i = index(input_restart_file, '.r.') + if (i>0) then + stoch_restfile = input_restart_file(1:i)//'r_stoch'//input_restart_file(i+2:k) + call MOM_mesg("input_restart_file = "//trim(input_restart_file), 3) + call MOM_mesg("stoch_restfile = "//trim(stoch_restfile), 3) + endif + endif call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & Time_in, offline_tracer_mode=OS%offline_tracer_mode, & input_restart_file=input_restart_file, & @@ -389,7 +403,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! vertical integrals, since the related 3-d sums are not negligible in cost. call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & do_integrals=.true., gas_fields_ocn=gas_fields_ocn, & - use_meltpot=use_melt_pot, use_marbl_tracers=OS%use_MARBL) + use_meltpot=use_melt_pot, use_MARBL_tracers=OS%use_MARBL) call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp, OS%use_waves) @@ -435,7 +449,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i endif call extract_surface_state(OS%MOM_CSp, OS%sfc_state) -! get number of processors and PE list for stocasthci physics initialization +! get number of processors and PE list for stochastic physics initialization call get_param(param_file, mdl, "DO_SPPT", OS%do_sppt, & "If true, then stochastically perturb the thermodynamic "//& "tendencies of T,S, and h. Amplitude and correlations are "//& @@ -446,6 +460,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "production and dissipation terms. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) + call get_param(param_file, mdl, "DO_SKEB", OS%do_skeb, & + "If true, then stochastically perturb the currents "//& + "using the stochastic kinetic energy backscatter scheme.",& + default=.false.) call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) @@ -545,9 +563,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then - ! enable_averages() is necessary to post forcing fields to diagnostics - call enable_averages(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) - if (do_thermo) & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, dt_coupling, & OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & @@ -772,8 +787,8 @@ subroutine ocean_model_restart(OS, timestamp, restartname, stoch_restartname, nu endif endif if (present(stoch_restartname)) then - if (OS%do_sppt .OR. OS%pert_epbl) then - call write_stoch_restart_ocn('RESTART/'//trim(stoch_restartname)) + if (stoch_restart_needed(OS)) then + call write_stoch_restart_ocn(trim(stoch_restartname)) endif endif @@ -1130,7 +1145,6 @@ end subroutine Ocean_stock_pe !> Write out checksums for fields from the ocean surface state subroutine ocean_public_type_chksum(id, timestep, ocn) - character(len=*), intent(in) :: id !< An identifying string for this call integer, intent(in) :: timestep !< The number of elapsed timesteps type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly @@ -1156,8 +1170,8 @@ end subroutine ocean_public_type_chksum subroutine get_ocean_grid(OS, Gridp) ! Obtain the ocean grid. - type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp + type(ocean_state_type), intent(in) :: OS + type(ocean_grid_type) , pointer, intent(out) :: Gridp Gridp => OS%grid return @@ -1165,8 +1179,14 @@ end subroutine get_ocean_grid !> Returns eps_omesh read from param file real function get_eps_omesh(OS) - type(ocean_state_type) :: OS + type(ocean_state_type), intent(in) :: OS get_eps_omesh = OS%eps_omesh; return end function +!> Returns true if a stochastic restart file is needed +logical function stoch_restart_needed(OS) + type(ocean_state_type), intent(in) :: OS + stoch_restart_needed = OS%do_sppt .OR. OS%pert_epbl .OR. OS%do_skeb +end function stoch_restart_needed + end module MOM_ocean_model_nuopc diff --git a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 index b82cb00f01..5d3bdc2462 100644 --- a/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 +++ b/config_src/drivers/nuopc_cap/mom_surface_forcing_nuopc.F90 @@ -83,7 +83,7 @@ module MOM_surface_forcing_nuopc !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. logical :: use_CFC !< enables the MOM_CFC_cap tracer package. - logical :: use_marbl_tracers !< enables the MARBL tracer package. + logical :: use_MARBL_tracers !< enables the MARBL tracer package. logical :: enthalpy_cpl !< Controls if enthalpy terms are provided by the coupler or computed !! internally. real :: gust_const !< constant unresolved background gustiness for ustar [R L Z T-2 ~> Pa] @@ -328,7 +328,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, if (fluxes%dt_buoy_accum < 0) then call allocate_forcing_type(G, fluxes, water=.true., heat=.true., ustar=.true., & press=.true., fix_accum_bug=.not.CS%ustar_gustless_bug, & - cfc=CS%use_CFC, marbl=CS%use_marbl_tracers, hevap=CS%enthalpy_cpl, & + cfc=CS%use_CFC, marbl=CS%use_MARBL_tracers, hevap=CS%enthalpy_cpl, & tau_mag=.true., ice_ncat=IOB%ice_ncat) call safe_alloc_ptr(fluxes%omega_w2x,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%sw_vis_dir,isd,ied,jsd,jed) @@ -617,7 +617,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, valid_time, G, ! Copy MARBL-specific IOB fields into fluxes; also set some MARBL-specific forcings to other values ! (constants, values from netCDF, etc) - if (CS%use_marbl_tracers) & + if (CS%use_MARBL_tracers) & call convert_driver_fields_to_forcings(IOB%atm_fine_dust_flux, IOB%atm_coarse_dust_flux, & IOB%seaice_dust_flux, IOB%atm_bc_flux, IOB%seaice_bc_flux, & IOB%nhx_dep, IOB%noy_dep, IOB%atm_co2_prog, IOB%atm_co2_diag, & @@ -1274,7 +1274,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call get_param(param_file, mdl, "USE_CFC_CAP", CS%use_CFC, & default=.false., do_not_log=.true.) - call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_marbl_tracers, & + call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_MARBL_tracers, & default=.false., do_not_log=.true.) call get_param(param_file, mdl, "ENTHALPY_FROM_COUPLER", CS%enthalpy_cpl, & @@ -1470,7 +1470,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags, use_waves=use_waves, & - use_cfcs=CS%use_CFC, use_glc_runoff=glc_runoff_diags) + use_cfcs=CS%use_CFC, use_MARBL_tracers=CS%use_MARBL_tracers, & + use_glc_runoff=glc_runoff_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the "//& @@ -1485,7 +1486,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, endif ! Set up MARBL forcing control structure - call MARBL_forcing_init(G, US, param_file, diag, Time, CS%inputdir, CS%use_marbl_tracers, & + call MARBL_forcing_init(G, US, param_file, diag, Time, CS%inputdir, CS%use_MARBL_tracers, & CS%marbl_forcing_CSp) if (present(restore_salt)) then ; if (restore_salt) then diff --git a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 index 50f70c3978..660f4d84e6 100644 --- a/config_src/drivers/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/drivers/solo_driver/MOM_surface_forcing.F90 @@ -118,7 +118,7 @@ module MOM_surface_forcing !! rotationally invariant and more likely to be the same between compilers. logical :: ustar_gustless_bug !< If true, include a bug in the time-averaging of the !! gustless wind friction velocity. - logical :: use_marbl_tracers !< If true, allocate memory for forcing needed by MARBL + logical :: use_MARBL_tracers !< If true, allocate memory for forcing needed by MARBL ! if WIND_CONFIG=='scurves' then use the following to define a piecewise scurve profile real :: scurves_ydata(20) = 90. !< Latitudes of scurve nodes [degreesN] real :: scurves_taux(20) = 0. !< Zonal wind stress values at scurve nodes [R L Z T-2 ~> Pa] @@ -289,7 +289,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US ! Allocate memory for the mechanical and thermodynamic forcing fields. call allocate_mech_forcing(G, forces, stress=.true., ustar=.not.CS%nonBous, press=.true., tau_mag=CS%nonBous) - call allocate_forcing_type(G, fluxes, ustar=.not.CS%nonBous, marbl=CS%use_marbl_tracers, tau_mag=CS%nonBous, & + call allocate_forcing_type(G, fluxes, ustar=.not.CS%nonBous, marbl=CS%use_MARBL_tracers, tau_mag=CS%nonBous, & fix_accum_bug=.not.CS%ustar_gustless_bug) if (trim(CS%buoy_config) /= "NONE") then if ( CS%use_temperature ) then @@ -386,7 +386,7 @@ subroutine set_forcing(sfc_state, forces, fluxes, day_start, day_interval, G, US endif endif - if (CS%use_marbl_tracers) then + if (CS%use_MARBL_tracers) then call MARBL_forcing_from_data_override(fluxes, day_center, G, US, CS) endif @@ -2150,7 +2150,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C call read_netCDF_data(filename, 'gustiness', CS%gust, G%Domain, & rescale=US%Pa_to_RLZ_T2*US%L_to_Z) ! units in file should be [Pa] endif - call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_marbl_tracers, & + call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_MARBL_tracers, & default=.false., do_not_log=.true.) ! All parameter settings are now known. @@ -2183,7 +2183,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, tracer_flow_C endif ! Set up MARBL forcing control structure - call MARBL_forcing_init(G, US, param_file, diag, Time, CS%inputdir, CS%use_marbl_tracers, & + call MARBL_forcing_init(G, US, param_file, diag, Time, CS%inputdir, CS%use_MARBL_tracers, & CS%marbl_forcing_CSp) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles) diff --git a/config_src/external/MARBL/marbl_interface.F90 b/config_src/external/MARBL/marbl_interface.F90 index 4b57472798..e4f4f51cfb 100644 --- a/config_src/external/MARBL/marbl_interface.F90 +++ b/config_src/external/MARBL/marbl_interface.F90 @@ -41,6 +41,7 @@ module marbl_interface procedure, public :: put_setting !< dummy put_setting routine procedure, public :: get_setting !< dummy get_setting routine procedure, public :: init !< dummy init routine + procedure, public :: autotroph_tracer_consistency_enforce !< dummy consistency enforcement procedure, public :: compute_totChl !< dummy routine to compute total Chlorophyll procedure, public :: surface_flux_compute !< dummy surface flux routine procedure, public :: interior_tendency_compute !< dummy interior tendency routine @@ -95,6 +96,15 @@ subroutine init(self, & call MOM_error(FATAL, error_msg) end subroutine init + !> Dummy version of MARBL's autotroph_tracer_consistency_enforce() function + subroutine autotroph_tracer_consistency_enforce(self) + + class(marbl_interface_class), intent(inout) :: self + + call MOM_error(FATAL, error_msg) + + end subroutine autotroph_tracer_consistency_enforce + !> Dummy version of MARBL's compute_totChl() function subroutine compute_totChl(self) diff --git a/config_src/external/stochastic_physics/stochastic_physics.F90 b/config_src/external/stochastic_physics/stochastic_physics.F90 index 40f9cf9fa8..718e80ab8a 100644 --- a/config_src/external/stochastic_physics/stochastic_physics.F90 +++ b/config_src/external/stochastic_physics/stochastic_physics.F90 @@ -60,7 +60,7 @@ end subroutine init_stochastic_physics_ocn !> Determines the stochastic physics perturbations. subroutine run_stochastic_physics_ocn(sppt_wts, skeb_wts, t_rp1, t_rp2) real, intent(inout) :: sppt_wts(:,:) !< array containing random weights for SPPT range [0,2] - real, intent(inout) :: skeb_wts(:,:) !< array containing random weights for SKEB + real, intent(inout) :: skeb_wts(:,:) !< array containing random weights for SKEB with units of a length [m] real, intent(inout) :: t_rp1(:,:) !< array containing random weights for ePBL !! perturbations (KE generation) range [0,2] real, intent(inout) :: t_rp2(:,:) !< array containing random weights for ePBL diff --git a/config_src/external/stochastic_physics/stochy_data_mod.F90 b/config_src/external/stochastic_physics/stochy_data_mod.F90 new file mode 100644 index 0000000000..f67513a956 --- /dev/null +++ b/config_src/external/stochastic_physics/stochy_data_mod.F90 @@ -0,0 +1,10 @@ +!>@brief The module 'stochy_data_mod' contains the initilization routine that read the stochastic phyiscs +!! namelist and determins the number of random patterns. +module stochy_data_mod + +implicit none +public :: stoch_restfile + +character(len=128) :: stoch_restfile = './INPUT/ocn_stoch.res.nc' !< default restart file name + +end module stochy_data_mod diff --git a/docs/AGENTS.md b/docs/AGENTS.md new file mode 100644 index 0000000000..49356aea05 --- /dev/null +++ b/docs/AGENTS.md @@ -0,0 +1,292 @@ +# MOM6 rules for agent-assisted development + +## First Steps + +**At the start of every session**, remind the user that MOM6 has a policy on AI-assisted +contributions in `Consortium-policy-on-AI.md`. + +Read `Code-style.md` before writing or modifying any code. + +See `code_organization.rst` for a high-level overview of the source directory tree. + +## Parameter System + +Runtime parameters are read via `get_param()`, not hardcoded: + +```fortran +#include "version_variable.h" +character(len=40) :: mdl = "MOM_module_name" + +call log_version(param_file, mdl, version, "") +call get_param(param_file, mdl, "PARAM_NAME", CS%variable, & + "Description of this parameter.", & + units="m s-1", default=1.0, scale=US%m_s_to_L_T) +``` + +- Parameters documented in auto-generated `MOM_parameter_doc.all` files +- Use `scale=` argument for unit conversion from MKS input to internal units +- Always provide `default=` when sensible; use `fail_if_missing=.true.` otherwise +- Use `do_not_log=.not.CS%Feature` to suppress logging when a parent feature is inactive + +### Answer-Changing Parameters: `_BUG` Flags and `ANSWER_DATE` + +When a bug fix or improvement changes numerical answers, MOM6 uses two mechanisms to preserve backward compatibility: + +**`_BUG` flags**: Boolean parameters that retain old (buggy) behavior by default: +```fortran +call get_param(param_file, mdl, "ENABLE_BUGS_BY_DEFAULT", enable_bugs, & + default=.true., do_not_log=.true.) ! This is logged from MOM.F90. +call get_param(param_file, mdl, "OBC_TEMP_SALT_NEEDED_BUG", OBC%ts_needed_bug, & + "If true, recover a bug that OBC temperature and salinity can be ignored "//& + "even if they are registered tracers in the rest of the model.", & + default=enable_bugs) +``` +- Name format: `FEATURE_BUG` (e.g., `VISC_REM_BUG`, `FRICTWORK_BUG`, `KAPPA_SHEAR_ITER_BUG`) +- Default is `.true.` (bug ON, old behavior preserved) +- Description starts with "If true, recover a bug that..." +- Users opt into the fix by setting to `.false.` + +**`ANSWER_DATE` flags**: Integer dates selecting algorithm versions: +```fortran +call get_param(param_file, mdl, "HOR_DIFF_ANSWER_DATE", CS%answer_date, & + "...", default=99991231) +``` +- Format: `YYYYMMDD` (e.g., `20251231`) +- `DEFAULT_ANSWER_DATE` provides a single knob to update all answer-date defaults +- `ENABLE_BUGS_BY_DEFAULT=False` activates all bug fixes (recommended for new configurations) + +## Diagnostics + +### Registration Pattern + +```fortran +CS%id_field = register_diag_field('ocean_model', 'field_name', diag%axesTL, Time, & + 'Long description of the field', units='m s-1', conversion=US%L_T_to_m_s) +``` + +### Posting Pattern + +```fortran +if (CS%id_field > 0) call post_data(CS%id_field, field_array, CS%diag) +``` + +Key conventions: +- `conversion=` handles unit scaling so output is always in MKS +- `v_extensive=.true.` for vertically integrated quantities +- Guard computation with `if (id > 0)` to avoid unnecessary work +- Standard diagnostic name prefixes follow CMOR conventions when applicable + +### Masking and Missing Values + +- **Never set diagnostic arrays to a missing value** before passing to `post_data()`. Masking of land/invalid points is handled automatically by the diagnostics infrastructure based on the diagnostic's registered axes. +- **Do not pass `mask=` to `post_data()`** for non-static diagnostics on standard grids -- the infrastructure applies the correct mask automatically. +- **Do pass `mask=`** for static fields (`is_static=.true.`), non-standard masks, or sub-domain-sized arrays. +- **Never compare field values against `missing_value`** in unit-conversion code -- rescaling can cause valid data to coincidentally match the missing value sentinel. + +## Testing + +### Test Suite Overview + +The `.testing/` directory provides comprehensive verification. Build and run: + +```bash +make -C .testing -j build/symmetric/MOM6 # Build reference executable +make -C .testing -j test # Run full test suite +make -C .testing -j build.unit # Build unit tests +make -C .testing -j run.unit # Run unit tests +``` + +### Test Categories + +| Test | Verifies | +|------|----------| +| `test.grid` | Symmetric vs asymmetric grids produce identical results | +| `test.layout` | Serial vs parallel decomposition identical | +| `test.rotate` | Rotational invariance | +| `test.restart` | Continuous run vs restart-and-continue identical | +| `test.repro` | DEBUG and REPRO builds identical | +| `test.openmp` | Serial vs OpenMP identical | +| `test.nan` | NaN-initialization doesn't affect results | +| `test.dim.{t,l,h,z,q,r}` | Dimensional rescaling invariance (time, length, thickness, depth, enthalpy, density) | +| `test.regression` | Current code vs target branch (PRs only) | + +### Test Configurations + +- `tc0` -- Unit tests +- `tc1` / `tc1.a` / `tc1.b` -- Benchmark (split RK2, unsplit RK3, unsplit RK2) +- `tc2` / `tc2.a` -- ALE with tides / sigma-coordinate PPM_H4 +- `tc3` -- Open boundary conditions +- `tc4` -- Sponges and I/O initialization + +### Verification Method + +- `ocean.stats` -- total energy at machine precision +- `chksum_diag` -- mean/min/max/bitcount checksums in physical domain +- Tests pass only when output is **bitwise identical** between configurations + +### Style Checking + +```bash +./.testing/trailer.py -e TEOS10 -l 120 src config_src +``` + +Checks for tabs, trailing whitespace, and line length violations. + +## Git Workflow & Contribution + +### Branch Strategy + +- **Work on forks**, not branches on the primary repository +- **Branch from the fork's default branch** (e.g., `dev/gfdl`, `dev/ncar`) for all new work +- **Never rebase a pushed branch** +- The human contributor submits changes via pull requests to the fork's default branch (e.g., `dev/gfdl`); merges to `main` are done by consortium consensus + +### Commit Message Format + +``` +Short imperative summary (50 chars if at all possible) + +Detailed explanation wrapped at 72 characters. +Describe what was changed and why. Reference issues with #NNN. +All answers are bitwise identical. +``` + +Conventions from the lead developers: +- **`*` prefix** on title if the commit changes numerical answers (checksums) +- **`+` prefix** on title to indicate new public interfaces or parameters +- **`*+` or `+*`** when both answer-changing and adding new interfaces +- No prefix for refactoring, cleanup, or comment-only changes that are bitwise identical +- **Always state impact on numerical results**: "All answers are bitwise identical" or explain what changes +- **Multi-commit PRs**: introduce infrastructure first, use it in a second commit +- **Minimize public scope**: only export symbols needed by other modules; remove from `public` when refactoring makes a symbol internal-only +- **Comment closing `enddo`/`endif`** for non-trivial nested loops: `enddo ! n-loop for segments` + +### PR Description Style + +1. Lead with a clear explanation of what changed and why +2. Quantify scope (e.g., "across 26 files", "in 7 places") +3. For answer-changing PRs, provide scientific justification +4. State the bitwise-identical guarantee (or explain what changes and why) +5. When a fix could change answers, protect with a `_BUG` flag or `ANSWER_DATE` parameter. New `_BUG` flags should default to `ENABLE_BUGS_BY_DEFAULT` so that users who have opted into all fixes get the new fix automatically; existing `_BUG` flags may already default to `.false.` if the fix has been broadly adopted. + +### CI Pipeline + +On every push and PR, GitHub Actions runs: +1. Style and Doxygen checks +2. Builds across 8 configurations (symmetric, asymmetric, repro, openmp, target, opt, coverage, coupled API) +3. All test groups in parallel +4. Code coverage reporting +5. For PRs: regression testing and timing comparison against target branch + +## Physics Domain Knowledge + +### Governing Equations +- Hydrostatic primitive equations optionally with Boussinesq approximation +- ALE vertical coordinate: Lagrangian dynamics with periodic remapping +- Split barotropic-baroclinic time stepping (RK2 split or unsplit RK3) +- Free surface dynamics (implicit barotropic solver) + +### Numerical Methods +- Finite volume on Arakawa C-grid (staggered: velocities at cell faces, tracers at centers) +- PPM (Piecewise Parabolic Method) for tracer advection and continuity +- Various reconstruction schemes: PLM, PPM, PQM, WENO, PLM-WLS +- Pressure gradient force via finite-volume integration +- Reproducing global sums for parallel reproducibility + +### Key Physical Parameterizations +- **ePBL**: Energetically consistent planetary boundary layer (Reichl and Hallberg) +- **KPP**: K-Profile Parameterization via CVMix +- **Gent-McWilliams/Redi**: Thickness and isopycnal diffusion +- **MEKE**: Mesoscale eddy kinetic energy budget +- **Zanna-Bolton**: Data-driven subgrid momentum closure +- **Tidal forcing**: Astronomical and self-attraction/loading + +## Common Development Tasks + +### Adding a New Parameterization +1. Create `MOM_new_param.F90` in the appropriate `src/parameterizations/` subdirectory +2. Define a control structure type (`new_param_CS`) with `private` members +3. Implement `new_param_init()`: read parameters via `get_param`, register diagnostics +4. Implement the main computational subroutine +5. Implement `new_param_end()` for cleanup +6. Wire it into the calling module (e.g., `MOM_diabatic_driver.F90`) +7. Document all variables with proper units +8. Add unit tests in `config_src/drivers/unit_tests/` if applicable +9. Run the full test suite: `make -C .testing -j test` + +### Adding a New Diagnostic +1. Add `integer :: id_new_diag = -1` to the control structure +2. Register in `_init` with `register_diag_field('ocean_model', 'name', axes, Time, ...)` +3. Compute and post with `if (CS%id_new_diag > 0) call post_data(CS%id_new_diag, array, CS%diag)` +4. Include `conversion=` for unit scaling to MKS output +5. Provide CMOR standard name when applicable + +### Adding a Runtime Parameter +1. Add member to control structure with units documentation +2. Call `get_param(param_file, mdl, "PARAM_NAME", CS%param, "description", units="...", default=...)` +3. Use `scale=` for dimensional conversion from MKS input +4. If the parameter could change answers, default to preserving existing behavior + +### Fixing a Bug +- Always state whether the fix changes answers in the commit message +- **Any change that alters existing numerical answers** -- whether a bug fix, accuracy improvement, or algorithmic reorganization -- must provide a runtime parameter (`_BUG` flag or `ANSWER_DATE`) to toggle between old and new behavior, with the default preserving old behavior +- This applies even when the developer's tests show negligible differences -- existing users may be in production runs +- Trace through secondary effects before concluding the fix is safe +- Run `test.regression` to verify impact + +## Architecture: Infrastructure Layering + +MOM6 has a strict dependency hierarchy that must never be violated: + +``` +config_src/infra/ --> src/framework/ --> src/core/, src/parameterizations/, etc. +``` + +- **`config_src/infra/`** (FMS1/FMS2 wrappers) must **never** import from `src/framework/` +- **Code duplication** between infra and framework is acceptable to maintain this invariant +- FMS1 and FMS2 infra directories must expose the same public API +- API changes to infra-level functions must be checked against downstream consumers (SIS2, ice shelf code) + +## Defensive Programming + +- **Check `allocated()` / `associated()`** before accessing arrays tied to optional features (e.g., features controlled by runtime parameters like `FRAZIL` may not allocate all related arrays) +- **No short-circuit evaluation**: Fortran does not guarantee short-circuit evaluation; allocation checks must not appear in compound conditions. Convert `if (allocated(arr) .and. (condition))` to nested if-blocks +- **Type-correct comparisons**: when comparing real-valued masks, use `== 1.` not `== 1` +- **FATAL error messages** should include: file name, subroutine name, and the specific condition or input that triggered the error +- **Validate user inputs early**: check for duplicates, overflow, and missing required fields in configuration parsing; include the problematic input string in error messages +- **`!###` comment prefix** marks known bugs or inaccurate expressions that change answers and will be cleaned up later -- do not modify code marked with `!###` unless explicitly asked + +## Common Pitfalls + +In addition to the code style rules in `Code-style.md`: + +1. **Forgetting units in comments**: every `real` variable needs `[units]` (see `Code-style.md`) +2. **Answer-changing without a `_BUG` flag**: any numerical change requires a runtime parameter to preserve old behavior +3. **Unnecessary `mask=` in `post_data()`**: the infrastructure handles masking automatically for non-static diagnostics +4. **Accessing unallocated optional arrays**: always check `allocated()` before using arrays tied to optional features + +### Key References + +The project bibliography lives in `docs/references.bib` and `docs/zotero.bib`. Consult these +when citing prior work in Doxygen documentation or commit messages. + +## AI Assistant Behavior + +- **Follow existing patterns**: read surrounding code before making changes +- **Document all units**: every real variable gets `[units]` annotation +- **Parenthesize arithmetic**: explicit grouping for reproducibility +- **State answer impact**: always note whether changes are bitwise identical +- **Use `get_param`**: never hardcode parameters; always read from parameter files +- **Register diagnostics properly**: guard with `if (id > 0)`, use `conversion=` +- **Maintain lifecycle**: implement `_init` and `_end` for new modules +- **Run tests**: `make -C .testing -j test run.unit` before the contributor submits a PR +- **Respect the C-grid**: use correct staggering (soft case convention for indices) +- **Write Doxygen comments**: `!>` for entities, `!<` for inline, with units +- **Write thorough commit messages**: explain both what changed and why in the commit body + +## Common Claude Mistakes + +This section catalogs recurring mistakes that Claude makes when working on MOM6 code. It should be updated as new patterns emerge from experience. + +*(No entries yet -- add mistakes here as they are discovered.)* + diff --git a/docs/Code-style.md b/docs/Code-style.md new file mode 100644 index 0000000000..f006638178 --- /dev/null +++ b/docs/Code-style.md @@ -0,0 +1,330 @@ +# MOM6 code style guide + +MOM6 makes use of Fortran2003 and later extensions but only when supported by all available compilers. We try to avoid the use of very modern Fortran constructs that can limit portability. To help keep the code readily understandable, this page makes recommendations about how to use or not use the various features of the modern Fortran language. + +Code style is typically a personal choice, but when styles clash it can lead to discord. These +standards have been adopted in an attempt to promote harmony and clarity. + +## White space + +- No tabs +- No trailing white space +- Indents should be consistent (same amount used in contiguous blocks) +- Preferred indent is 2 spaces + - "preferred" might understate the reaction invoked by other indent amounts! :wink: +- Continuation lines should be indented at least 4 spaces, but more space can be used if it helps align lines + - One exception is the continuation line after a simple `if` test with no `then`, which could be 2 space indent as though the `then` and `endif` were present. I.e., +``` + if (test) & + var = expression +``` +and +``` + if (test) then + var = expression + endif +``` +should have the same indenting on `var = expression` so that there would be no need to change the indenting if another statement were added to the `if` block, or if the latter expression were converted to the former. +- No white space between a function name and the opening parenthesis +- White space after all language token + - `if(a==0)` is legal fortran but bad style. Use `if (a==0)` instead. + - `if (a == 0)` is even better, since `==` is a language token. +- Use space around the equal sign in variable assignment, but not when using a named optional argument + - `a = b` is strongly preferred over `a=b` + - One exception is loop indices, where `do i=is,ie` is acceptable + - `call fn(arg1, arg_name=a)` is strongly preferred over `call fn(arg1, arg_name = a)` +- Use a space after the comma separating subroutine or function arguments in calls and declarations (e.g., `call fn(arg1, arg2, arg3)`), but usually not after the comma separating array indices for multidimensional arrays (e.g., `A(i,j,k) = B(i,j,k)`). + +## Line length + +Some compilers handle very long lines of code gracefully, but MOM6 needs to adhere to the Fortran standard, which is 132 characters for code, after any macro expansion. MOM6 does use macros for some memory declarations, +so we need to build in some added space in setting MOM6 guidelines: +- The target maximum length for MOM6 code lines is 120 characters, including comments. + - 80 character lines can be much easier to read if printed; smaller lines are encouraged where they make sense + +## Local variables + +- Local variable declarations appear after all the dummy argument declarations, and in the case of a function the return value. We often use ` ! Local variables` to delineate between the argument and local variable declarations. +- Local variables should preferably be descriptive multi-character names meaningful in their context, e.g. `del_rho_int` (delta rho at interface). + - If using a highly abbreviated or short name, the declaration **MUST** be commented. + - Units should be provided in the comments describing real variables. + - Multi-word names should use [snake_case](https://en.wikipedia.org/wiki/Snake_case) (e.g. `delta_rho`). + - snake_case admittedly used more characters than [camelCase](https://en.wikipedia.org/wiki/CamelCase) but unfortunately Doxygen interprets the Fortran standard too literally and throws away any attempts to use CamelCase. We briefly adopted CamelCase for new code but are systematically replacing it as we Doxygen-ize existing code. + +## Block constructs + +- `do` and `if` constructs should be terminated with the combined `enddo` and `endif` statements, respectively. +- All other block end statements separate the `end` token (e.g. `end program [label]`) + - Examples: `program`, `module`, `type`, `subroutine`, `function`, `interface`, `select` + +## Loop indices + +### Soft case convention +- `i`,`j`,`k` are used for cell-center, layer-center references, e.g. `h(i,j,k)`, `T(i+1,j,k)`. +- `I`,`J` are used for staggered, cell-edge references, e.g. `u(I,j,k)`, `v(i,J,k)`, `q(I,J,k)`, `u(I-1,j,k)`. We use a north-east staggering convention so the `I` means i+1/2 and `I-1` means i-1/2. +- `K` is used for the interface (between layer) references, e.g. `del_t(i,j,K) = T(i,j,K+1) - T(i,j,K)`. The vertical staggering is such that interface `K=1` is above layer `k=1` so that `K` means k-1/2 and `K+1` means k+1/2. + +## Global / module data + +- Absolutely **NO**! +- There are a few exceptions which are strictly for debugging non-shared memory applications. Do not use these as an excuse for adding module data. + +## Module use statements +- Modules may use interfaces, data-types, and constant parameters from other modules via module use statements + - Modules may not use variables from other modules via use statements + - All MOM variables are passed around as explicit arguments in interfaces. +- All module use statements must include the `, only` modifier + +## Implicit variables +- Absolutely **NO**! +- All MOM6 modules must declare `implicit none ; private` + - Top-level drivers (i.e., files declaring a program main()) only need `implicit none` + +## Array syntax + +- We **do not permit scalar-style expressions without the colon notation**, e.g. + - `tv%S = 0.` is forbidden. +- We do allow array syntax for whole array initialization, e.g. + - `tv%S(:,:,:) = 0.` +- We do allow array syntax for identical copies, e.g. + - `S_tmp(:,:,:) = tv%S(:,:,:)` +- We do not allow whole array-syntax for math expressions that include halos because halos are not guaranteed to have valid data: + - `tmp(:,:) = 1.0 / G%areaT(:,:)` might have zeros in the halo region. + - `call post_data(id_AT, G%areaT(:,:)*tv%(T(:,:,1))` is wrong because it can use uninitialized data in halos. + +## Data flow + +- All needed data is passed via arguments to subroutines and functions, or as the returned value of a function. +- All arguments must have declared intent, with the exception of pointers: i.e. `intent(in)`, `intent(out)`, `intent(inout)`. +- Opaque types are preferred, i.e. referencing members of types defined in other modules is discouraged. + +## Documentation in code + +- Do it when you are writing the code in the first place! +- All subroutines, functions, arguments, and elements of public types should be described in with Doxygen comments. +- All real variables should have a full physical description, including units. +- All comments should be clearly written and grammatically correct; American spelling is preferred. + +## Optimization for divides + +Divisions are prone to NaNs and relatively expensive. An optimizing compiler will often rearrange math which makes debugging divisions by zero harder to catch. +- Many common reciprocals are pre-computed + - Use `Q(i,j) * G%IareaT(i,j)` instead of `Q(i,j) / G%areaT(i,j)`. +- Never write `B / C * D` which is ambiguous to humans (not the compiler) + - Use `( B * D ) / C` +- Never double divide: `A / ( A + B / C)` + - Use `( A * C ) / ( A * C + B)` + + +## Arithmetic reproducibility + +Floating point operations are sensitive to the order of operations (associativity), which can not generally be guaranteed due to compiler serialization and optimization. + + +### Addition + +Addition operations must be done in pairs. When more than one addition is required, the order should be specified using parentheses. + +- This is bad: + - `z = a + b + c` +- This is good: + - `z = (a + b) + c` + +Ideally, the order of operation should be chosen to give the best accuracy. For example, if `a = 1.` `b = -1.` and `c = 1.e-20`, then the order should be chosen to preserve the residual value. + +- This is bad: + - `a + (b + c) == 0.` +- This is good: + - `(a + b) + c == 1.e-20` + +Not only does this impact reproducibility, but the second choice is more accurate and avoids a potential division by zero. + +All operations should be ordered, but no particular ordering is enforced. Contributors are encouraged to consider the most accurate order of operations. In some cases the order of sums can be chosen to give expressions that yield identical answers if the underlying horizontal coordinate is rotated by 90 or 180 degrees, which would define the preferred order of operations. + + +### `sum()` intrinsic + +We avoid the Fortran `sum()` intrinsic since the result is dependent on the order of operations within the summation. Using explicit loops allows us to define the order of summation. So +``` +a = sum(b(:)) +``` +should be +``` +a = 0. +do k = 1, nz + a = a + b(k) +enddo +``` +The `prod()` and `matmul()` intrinsics should also not be used. + + +### Global summation + +Floating point operations across MPI ranks are volatile, since the order can change depending on the state of the network. Functions such as `MPI_Reduce` will not generally be reproducible when used for floating point arithmetic. + +When performing summations over MPI ranks, use the `reproducing_sum` function. +``` +use MOM_coms, only: reproducing_sum +... +sum = reproducing_sum(array(:,:)) +``` + + +### Multiplication + +Multiplication is also non-associative and thus not reproducible, but the impact is typically small. Results may depend on the order of operations, most often in the least significant bit of the fractional component. + +In single precision, if `a = b = 1 + 2**-23` and `c = 1.5`, then the following calculations differ: + +- `(a*b)*c = 1.50000036` +- `a*(b*c) = 1.50000048` + +Parentheses in multiplication operations are currently not enforced, but contributors should consider using them when applicable. + + +### Transcendental functions + +Use of transcendental functions, such as trigonometric functions, non-integer powers, and logarithms, are often implementation-dependent and should be avoided when possible. + + +### Exponent operator + +The exponent operator, `a**b` should be used sparingly, since compilers will often internally replace it with `pow(a, b)`, which is often computed as a transcendental function, `exp(b * log(a))`. Even small integral power, such as `a**3`, have been known to be replaced with `pow(a, 3)`. To maximize reproducibility, integral powers should be explicitly computed, e.g. `a3 = a * a * a`. + +Square roots (`a**0.5`) should always use the `sqrt()` intrinsic. An IEEE-754 compliant `sqrt` function must be exactly rounded. + +Cube roots (`a**(1./3.)`) should be avoided, the MOM6 intrinsic `cuberoot` should be used. This is not exactly rounded, but it is reproducible. + + +## Module structure + +Every module follows this pattern: + +```fortran +!> Brief module description +module MOM_module_name + +! This file is part of MOM6. See LICENSE.md for the license. + +use MOM_some_module, only : specific_symbol +use MOM_other, only : other_thing + +implicit none ; private + +#include + +public :: exported_routine_1, exported_routine_2 + +!> Control structure for this module +type, public :: module_CS ; private + real :: param !< Description [units] + integer :: id_diag = -1 !< Diagnostic ID for some_field +end type module_CS + +contains + +!> Initialize the module, read parameters, register diagnostics +subroutine module_init(Time, G, GV, US, param_file, diag, CS) + ! ... call log_version, get_param, register_diag_field ... +end subroutine module_init + +!> Deallocate module memory +subroutine module_end(CS) + ! ... cleanup ... +end subroutine module_end + +!> \namespace MOM_module_name +!! Extended description, references, and equations +end module MOM_module_name +``` + +Key rules: +- Most modules have `_init` and `_end` subroutines for lifecycle management +- `! Local variables` comment separates dummy arguments from local declarations +- **Prefer `allocatable` over `pointer`** for control structure members + + +## Naming conventions + +- **Files**: one module per file; module name must match file name (e.g., `MOM_something.F90` contains module `MOM_something`) +- **Control structures**: `module_CS` (e.g., `energetic_PBL_CS`), always `public` but opaque (with `private` contents) +- **Diagnostic IDs**: `id_diag_name`, initialized to `-1` +- **Inverses**: prefix with `I` (e.g., `IdxCu` = `1/dxCu`, `IareaT` = `1/areaT`) +- **Grid objects**: `G` (ocean_grid_type), `GV` (verticalGrid_type), `US` (unit_scale_type) +- **Public functions**: self-documenting names; private helpers may use short names + + +## Memory macros + +Array dimensions use preprocessor macros from `MOM_memory.h`: +- `SZI_(G)`, `SZJ_(G)`, `SZK_(GV)` for explicit-shape cell-center arrays +- `SZIB_(G)`, `SZJB_(G)`, `SZKB_(GV)` for explicit-shape face/edge-point arrays +- `NIMEM_`, `NJMEM_`, `NKMEM_` for allocatable arrays + + +## Unit documentation + +MOM6 uses a dimensional annotation system for every real variable. Units are documented in square brackets at the end of comments, using a two-part notation: + +``` +[rescaled_dimensions ~> MKS_equivalent] +``` + +### Dimensional symbols + +| Symbol | Physical Dimension | MKS Unit | +|--------|-------------------|----------| +| Z | Vertical depth/distance | m | +| L | Horizontal length | m | +| T | Time | s | +| H | Layer thickness | m (Boussinesq) or kg m-2 | +| R | Density | kg m-3 | +| Q | Enthalpy | J kg-1 | +| C | Temperature | degC | +| S | Salinity | ppt | +| A | Arbitrary/generic units | a | + +### Examples + +```fortran +real :: velocity !< Horizontal velocity [L T-1 ~> m s-1] +real :: pressure !< Hydrostatic pressure [R L2 T-2 ~> Pa] +real :: thickness !< Layer thickness [H ~> m or kg m-2] +real :: diffusivity !< Vertical diffusivity [Z2 T-1 ~> m2 s-1] +real :: slope !< Isopycnal slope [Z L-1 ~> nondim] +real :: efficiency !< Mixing efficiency [nondim] +real :: field !< A field in arbitrary units [A] +real :: Z_to_m !< Scaling factor [m Z-1 ~> 1] +``` + +### Unit annotation rules + +1. **Every real variable** must have units in `[brackets]` at the end of its comment +2. **Canonical symbol ordering**: consistent order (e.g., `H L2` not `L2 H`) +3. **Boussinesq variants first**: `[H ~> m or kg m-2]` when units differ by approximation +4. **Simplified expressions only**: write `[T2 Z-1 ~> s2 m-1]`, not `[H Z T-1 / H Z2 T-3 = T2 Z-1 ~> s2 m-1]` +5. **Exponent notation**: `m-1`, `s-2`, `kg-3` (no slashes like `1/m`) +6. **No extra spaces** inside brackets +7. **Nondimensional**: use `[nondim]` +8. **Arbitrary/generic**: use `[A]` or `[A ~> a]`, never `[arbitrary]` +9. **Scaling factors**: `[target source-1 ~> 1]`, e.g., `[Z m-1 ~> 1]` + + +## Doxygen documentation + +### Comment syntax + +- `!>` for documentation comments on the following entity +- `!<` for inline documentation on the preceding entity (same line) +- `!!` for multi-line continuation (no blank lines between) +- `!>@{` and `!>@}` for grouping related declarations + +### Requirements + +- **All public subroutines/functions**: `!>` header describing purpose +- **All arguments**: documented with `!<` or `!>` including units +- **All type members**: documented with `!<` including units +- **All real variables**: must include physical description and units +- **Equations**: LaTeX with `\f$ ... \f$` (inline) or `\f[ ... \f]` (display) +- **Extended descriptions**: placed before `end module` using `\namespace` + diff --git a/docs/Consortium-policy-on-AI.md b/docs/Consortium-policy-on-AI.md new file mode 100644 index 0000000000..5388c3d249 --- /dev/null +++ b/docs/Consortium-policy-on-AI.md @@ -0,0 +1,61 @@ +# Policy for AI-generated code in MOM6 + +## Guiding Principle + +AI coding assistants are welcome in MOM6 development the same way any other tool is welcome — with the expectation that a human contributor is responsible for everything they submit. AI use is permitted when it supports a contributor's comprehension of the code; it is not permitted as a substitute for that comprehension. + + +## Contributor Responsibility + +Every contribution to MOM6 has a human author who is accountable for its correctness, physical consistency, and conformance to MOM6 coding standards. Every contribution must have a clearly articulated purpose that is succinctly documented in the commit messages and pull request descriptions. +Reviewers may ask any contributor, "Do you understand why this works?" and “Why are you suggesting this?” These questions are always appropriate, and a satisfactory answer is always expected. +Code that the contributor cannot explain should not be submitted. + + +## Disclosure + +Contributors must disclose AI assistance in any pull request or commit where AI tooling materially shaped the submitted code. The tool is not credited as an author; the disclosure is for the benefit of reviewers. +A brief note in the PR description is sufficient, e.g. "Note that an AI tool was used in making this contribution" + + +## Risks of AI-Assisted Code + +The fact that AI-generated code compiles and passes existing tests is not sufficient evidence of correctness. Sign errors, unit mismatches, and flux miscalculations can pass a compiler and look plausible. AI models are capable of producing syntactically correct Fortran; they do not understand ocean physics. + +Contributors and reviewers should be alert to the following categories of risk: + +Physical correctness: AI tools have no understanding of the underlying science. Parameterizations, numerical schemes, and flux calculations must be verified by a human with domain knowledge, not inferred to be correct because the code runs. +Comprehension debt: If a contributor does not fully understand code they have submitted, that gap compounds over time as the code is further modified, potentially again with AI assistance. See also Section on responsibility. +Vacuous tests: AI-generated tests may pass without actually testing anything meaningful. Tests must be evaluated for genuine coverage and practical relevance. +Code churn: Modifying code without a compelling purpose impedes the process of developing useful capabilities. +Malicious or unsafe code: AI tools can be manipulated through prompt injection or may reproduce unsafe patterns from their training data. Contributors must review AI-suggested code for suspicious logic, unexpected network calls, file system access, or other behavior inconsistent with the intended change. Any code that cannot be straightforwardly explained by its stated purpose should be treated as suspect. + + +## Roles for AI in the Workflow + +The following uses are encouraged, with appropriate human oversight: + +Development assistance: exploring code, planning changes, drafting implementations, explaining unfamiliar code, suggesting refactors. +Debugging: identifying likely error sources, interpreting compiler or runtime messages. +Documentation: drafting docstrings and comments, prose descriptions. +CI triage: understanding feedback or messages on CI failures (e.g., summarizing logs, suggesting fixes for straightforward failures). +Reviewing Pull Requests: AI tools may be used to highlight possible issues in contributions, such as bugs or points of inconsistency with MOM6 practice and policy or clarifying that a contribution is pure refactoring. However, only a human reviewer may approve a pull request after fully understanding what the contributed code does. + +The following uses require particular caution: + +Autonomous code contribution with minimal human oversight is not currently accepted. +AI-generated tests must be verified to test something meaningful; vacuously passing trivial tests is a known failure mode. + + +## Equity + +Policy and tooling must not implicitly require paid LLM access. Workflows, templates, and guidance documents must remain useful to contributors without access to commercial AI tools. + + +## Legal and Institutional Considerations + +The IP status of AI-generated code remains unsettled in many countries including the United States, Australia, Korea, the European Union, and the United Kingdom. +Contributors should be aware of their institutional policies before using AI tools. +Contributors are responsible for ensuring that AI tool use complies with their employer's policies. +This consortium does not endorse any specific AI vendor or tool. + diff --git a/docs/Doxyfile_nortd b/docs/Doxyfile_nortd index 4a81c20bd7..7a3447bc7f 100644 --- a/docs/Doxyfile_nortd +++ b/docs/Doxyfile_nortd @@ -860,6 +860,7 @@ WARN_LOGFILE = _build/doxygen_warn_nortd_log.txt INPUT = ../src \ front_page.md \ + Consortium-policy-on-AI.md \ ../config_src/drivers/solo_driver \ ../config_src/memory/dynamic_symmetric \ ../config_src/external \ diff --git a/docs/Doxyfile_nortd_latex b/docs/Doxyfile_nortd_latex index 207e645195..94d615e48f 100644 --- a/docs/Doxyfile_nortd_latex +++ b/docs/Doxyfile_nortd_latex @@ -860,6 +860,7 @@ WARN_LOGFILE = _build/doxygen_warn_nortd_latex_log.txt INPUT = ../src \ front_page.md \ + Consortium-policy-on-AI.md \ ../config_src/drivers/solo_driver \ ../config_src/memory/dynamic_symmetric \ ../config_src/external \ diff --git a/docs/Doxyfile_rtd b/docs/Doxyfile_rtd index 479c03e1b4..b389f1aeb7 100644 --- a/docs/Doxyfile_rtd +++ b/docs/Doxyfile_rtd @@ -810,6 +810,7 @@ WARN_LOGFILE = _build/doxygen_warn_rtd_log.txt # Note: If this tag is empty the current directory is searched. INPUT = ../src \ + Consortium-policy-on-AI.md \ ../config_src/drivers/solo_driver \ ../config_src/memory/dynamic_symmetric \ ../config_src/external \ diff --git a/docs/README.md b/docs/README.md index 1bec91f288..6467aa06ab 100644 --- a/docs/README.md +++ b/docs/README.md @@ -1,6 +1,6 @@ # Organization -The instructions for generation of MOM6 documentation is divided into three sections. +The instructions for generation of MOM6 documentation are divided into three sections. * [Documentation process](#documentation-process) * [Documentation syntax](#documentation-syntax) @@ -56,15 +56,16 @@ SRC/ drivers/ FMS_cap ice_solo_driver - mct_cap nuopc_cap solo_driver - unit_drivers + timing_tests + unit_tests external infra/ FMS1 + FMS2 memory/ - dynamic + dynamic_nonsymmetric dynamic_symmetric pkg/ CVMix-src @@ -91,14 +92,14 @@ SRC/ ## Doxygen -The [Doxygen](http://www.doxygen.org/) package is used to scan the source code for embedded documentation. Doxygen also automatically produces API documentation from arguments to subroutines, functions and member of types. The guide for using doxygen in MOM6 is hosted on the [MOM6 developer's wiki](https://github.com/NOAA-GFDL/MOM6/wiki/Doxygen). +The [Doxygen](http://www.doxygen.org/) package is used to scan the source code for embedded documentation. Doxygen also automatically produces API documentation from arguments to subroutines, functions and member of types. The guide for using doxygen in MOM6 is in [Code-style.md](Code-style.md). The majority of documentation is embedded in the comments of the source code. Additional documents have been added in the form of doxygen files (`*.dox`). The additional documents can be identified as those prefixed with an underscore (`_`) and have the `dox` extension. The content of the additional documents and source code should conform to usage as defined by the doxygen user and reference [manuals](https://www.doxygen.nl/manual/index.html). Further guidance is provided -on the [MOM6 developer's wiki](https://github.com/NOAA-GFDL/MOM6/wiki/Doxygen). +in [Code-style.md](Code-style.md). [Troubleshooting](details/Details.md) guides are provided with most commonly reported problems with MOM6 documentation. NOTE: Not all doxygen commands are supported through the sphinx documentation processor. Support can be added by adding an [issue](https://github.com/NOAA-GFDL/MOM6/issues) to the github repository. @@ -114,7 +115,7 @@ SRC/ MOM6.tags ``` -The main driver for doxygen is a configuration file. The content on [MOM6 developer's wiki](https://github.com/NOAA-GFDL/MOM6/wiki/Doxygen) uses the `Doxyfile_nortd` configuration file. +The main driver for doxygen is a configuration file. The content in [Code-style.md](Code-style.md) uses the `Doxyfile_nortd` configuration file. By default, the html directory is only available after processing the documentation. Please see [software operation](software-operation) on how to generate the pdf companion of the documentation. diff --git a/docs/about.rst b/docs/about.rst index 984e5776e8..981c60d8fc 100644 --- a/docs/about.rst +++ b/docs/about.rst @@ -13,14 +13,14 @@ Download, compile and run Installation, compilation and running are platform specific operations for which we can only provide templates (as is done in on the wiki) but for which MOM6 developers cannot possibly support since every platform is different. Normally a user needs to know where libraries (such as netcdf and MPI) and compilers are on their system but once these have - been established the documented compile process can be adpated to the local system. + been established the documented compile process can be adapted to the local system. User guide - `This site `_ provides a high-level overview of the model as well as the API reference (documentation + `This site `_ provides a high-level overview of the model as well as the API reference (documentation of source code). - The user guide is written in reStructuredText (.rst files) that reside in ``docs/`` of the `MOM6 source code `_. - The rst files are processed by sphinx and hosted on `readthedocs `_. + The user guide is written in reStructuredText (.rst files) that reside in ``docs/`` of the `MOM6 source code `_. + The rst files are processed by sphinx and hosted on `readthedocs `_. The API reference is generated documentation - we use doxygen for in-code documentation. The Fortran doxygen format is rather cumbersome for diff --git a/docs/code_organization.rst b/docs/code_organization.rst index 8e5ac39d57..aae9564bf0 100644 --- a/docs/code_organization.rst +++ b/docs/code_organization.rst @@ -3,7 +3,7 @@ Organization of the code The MOM6 source code is divided into a tree of directories (folders) to group related code (e.g. `src/core`) or similar modules (e.g. -`src/parametizations/vertical`). +`src/parameterizations/vertical`). The highest level of directories are: @@ -33,53 +33,45 @@ The highest level of directories are: The directory tree is:: MOM6 - ├── config_src - │   ├── drivers - │   │   ├── FMS_cap - │   │   ├── ice_solo_driver - │   │   ├── mct_cap - │   │   ├── nuopc_cap - │   │   ├── solo_driver - │   │   └── unit_drivers - │   ├── external - │   │   ├── GFDL_ocean_BGC - │   │   └── ODA_hooks - │   ├── memory - │   │   ├── dynamic_nonsymmetric - │   │   ├── dynamic_symmetric - ├── docs - │   └── images - ├── pkg - │   ├── CVMix-src - │   │   ├── ... - │   │   └── src - │   │      ├── drivers - │   │      └── shared - │   └── GSW-Fortran - ├── src - │ ├── ALE - │ ├── core - │ ├── diagnostics - │ ├── equation_of_state - │ │   └── TEOS10 - │ ├── framework - │ ├── ice_shelf - │ ├── initialization - │ ├── parameterizations - │ │   ├── CVmix -> ../../pkg/CVMix-src/src/shared - │ │   ├── lateral - │ │   └── vertical - │ ├── tracer - │ └── user - └── .testing - ├── tc0 - ├── tc1 - ├── tc1.a - ├── tc1.b - ├── tc2 - ├── tc2.a - ├── tc3 - └── tc4 + +-- config_src + | +-- drivers + | | +-- FMS_cap # GFDL coupler interface + | | +-- ice_solo_driver # Ice-only standalone + | | +-- nuopc_cap # NUOPC/CESM coupling + | | +-- solo_driver # Ocean-only standalone + | | +-- timing_tests # Performance benchmarks + | | +-- unit_tests # Unit test executables + | +-- external # Null hooks for optional components + | +-- infra # Framework interface (FMS1/FMS2 wrappers) + | | +-- FMS1 # FMS1 wrappers + | | +-- FMS2 # FMS2 wrappers + | +-- memory + | +-- dynamic_nonsymmetric + | +-- dynamic_symmetric + +-- docs + +-- pkg + | +-- CVMix-src # Community Vertical Mixing + | +-- GSW-Fortran # TEOS-10 Gibbs Seawater + +-- src + | +-- ALE # Vertical remapping/regridding + | +-- core # Dynamical core + | +-- diagnostics # Diagnostic calculations + | +-- equation_of_state # EOS implementations + | +-- framework # Infrastructure (diagnostics, I/O, parsing, domains) + | +-- ice_shelf # Ice shelf dynamics + | +-- initialization # Grid/state initialization + | +-- ocean_data_assim # Data assimilation + | +-- parameterizations + | | +-- lateral # Lateral parameterizations + | | +-- vertical # Vertical mixing + | +-- tracer # Tracer transport and specific tracers + | +-- user # Idealized configuration initialization + +-- .testing + +-- tc0 # Unit tests + +-- tc1 / tc1.a / tc1.b # Benchmark configurations + +-- tc2 / tc2.a # ALE with tides / sigma-coordinate + +-- tc3 # Open boundary conditions + +-- tc4 # Sponges and I/O initialization .. _config_src: @@ -88,9 +80,9 @@ The directory tree is:: `memory/dynamic_nonsymmetric/`, `memory/dynamic_symmetric/` One or none of `config_src/memory/dynamic_nonsymmetric/` or - `config_src/dynamic_symmetric/` can be included at compile time. If neither + `config_src/memory/dynamic_symmetric/` can be included at compile time. If neither is used then a `MOM_memory.h` file specific to the model configuration must be - present - this is known as a"static" compile with fixed layout and domain shape. + present - this is known as a "static" compile with fixed layout and domain shape. `external/` Contains "null" modules providing the API to optional components to use @@ -100,11 +92,15 @@ The directory tree is:: To use the actual ODA or BGC, add the appropriate source to the search paths . -`infra/FMS1` +`infra/` Contains MOM6-specific thin wrappers to all of the FMS types and routines that are used by MOM6. The code in this directory should only be called by the infrastructure-agnostic code in src/framework. +`drivers/ice_solo_driver/` + This driver produces a stand-alone ice-shelf executable that steps the + ice-shelf model without any ocean dynamics. + `drivers/solo_driver/` This driver produces an ocean-only executable with no other coupled components (no sea-ice, no atmosphere, etc.). It is the simplest @@ -115,6 +111,16 @@ The directory tree is:: compiling MOM6 along with at least a sea-ice model and possibly all other components in a coupled model. +`drivers/nuopc_cap/` + This driver provides a NUOPC-compliant interface for coupling MOM6 within + CESM or other NUOPC-based coupled systems. + +`drivers/unit_tests/` + Unit test executables for testing individual MOM6 components in isolation. + +`drivers/timing_tests/` + Performance benchmark executables for profiling MOM6 routines. + .. _src: `src/` @@ -137,9 +143,15 @@ The directory tree is:: Low-level wrappers for communication, diagnostics management, parsing of input parameters, time management, CPU clocks. +`ice_shelf/` + Ice shelf dynamics and thermodynamics. + `initialization/` Initialization of the horizontal grid, vertical coordinate, and the state. +`ocean_data_assim/` + Data assimilation interfaces. + `parameterizations/lateral` Sub-grid scale parameterization with fluxes primarily oriented in the lateral direction. diff --git a/docs/front_page.md b/docs/front_page.md index 4997244524..b85ac9908a 100644 --- a/docs/front_page.md +++ b/docs/front_page.md @@ -6,7 +6,7 @@ This documentation is also available as web-linkable pages hosted on [read the d If you are looking for a user guide, start at the [MOM6-examples wiki](https://github.com/NOAA-GFDL/MOM6-examples/wiki) which has installation instructions, links to tutorials, and more. -The APIs in MOM6 are documented using doxygen - you are viewing the result. A brief style guide for using doxygen in MOM6 is available at https://github.com/NOAA-GFDL/MOM6/wiki/Doxygen. +The APIs in MOM6 are documented using doxygen - you are viewing the result. A brief style guide for using doxygen in MOM6 is available in docs/Code-style.md in the repository. *** diff --git a/docs/zotero.bib b/docs/zotero.bib index 01fe2c6185..eb2423de02 100644 --- a/docs/zotero.bib +++ b/docs/zotero.bib @@ -1,5 +1,34 @@ % This file is generated by zotero. Manual edits will be lost! +@article{agarwal2023, + title={Impact of Stochastic Ocean Density Corrections on Air-Sea Flux Variability}, + author={Agarwal, Niraj and Small, R Justin and Bryan, Frank O and Grooms, Ian and Pegion, Philip J}, + journal={Geophysical Research Letters}, + volume={50}, + number={13}, + pages={e2023GL104248}, + year={2023}, +} + +@article{kenigson2022, + title={Parameterizing the impact of unresolved temperature variability on the large-scale density field: 2. Modeling}, + author={Kenigson, JS and Adcroft, A and Bachman, SD and Castruccio, F and Grooms, I and Pegion, P and Stanley, Z}, + journal={Journal of Advances in Modeling Earth Systems}, + volume={14}, + number={3}, + pages={e2021MS002844}, + year={2022}, +} + +@article{stanley2020, + title={Parameterizing the Impact of Unresolved Temperature Variability on the Large-Scale Density Field: {Part 1.} Theory.}, + author={Stanley, Z and Grooms, I and Kleiber, W and Bachman, SD and Castruccio, F and Adcroft, A}, + journal={Journal of Advances in Modeling Earth Systems}, + volume={12}, + number={12}, + pages={e2020MS002185}, + year={2020}, +} @article{redi1982, title = {Oceanic {Isopycnal} {Mixing} by {Coordinate} {Rotation}}, diff --git a/pkg/CVMix-src b/pkg/CVMix-src index c38ddb7ebd..fce422195a 160000 --- a/pkg/CVMix-src +++ b/pkg/CVMix-src @@ -1 +1 @@ -Subproject commit c38ddb7ebdd2d58c517b63a99bbdc8e348732db2 +Subproject commit fce422195a0c58f15a55946b5ed517ba4365e232 diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index 7e24d80a21..28ea5b13cb 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -1026,7 +1026,7 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & endif if (main_parameters .and. coord_is_state_dependent) then - call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", string, & + call get_param(param_file, mdl, "MAXIMUM_INT_DEPTH_CONFIG", longString, & "Determines how to specify the maximum interface depths.\n"//& "Valid options are:\n"//& " NONE - there are no maximum interface depths\n"//& @@ -1039,29 +1039,29 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & message = "The list of maximum depths for each interface." allocate(z_max(ke+1)) allocate(dz_max(ke)) - if ( trim(string) == "NONE") then + if ( trim(longString) == "NONE") then ! Do nothing. - elseif ( trim(string) == "PARAM") then + elseif ( trim(longString) == "PARAM") then call get_param(param_file, mdl, "MAXIMUM_INTERFACE_DEPTHS", z_max, & trim(message), units="m", scale=GV%m_to_H, fail_if_missing=.true.) call set_regrid_max_depths(CS, z_max) - elseif (index(trim(string),'FILE:')==1) then - if (string(6:6)=='.' .or. string(6:6)=='/') then + elseif (index(trim(longString),'FILE:')==1) then + if (longString(6:6)=='.' .or. longString(6:6)=='/') then ! If we specified "FILE:./xyz" or "FILE:/xyz" then we have a relative or absolute path - fileName = trim( extractWord(trim(string(6:80)), 1) ) + fileName = trim( extractWord(trim(longString(6:)), 1) ) else ! Otherwise assume we should look for the file in INPUTDIR - fileName = trim(inputdir) // trim( extractWord(trim(string(6:80)), 1) ) + fileName = trim(inputdir) // trim( extractWord(trim(longString(6:)), 1) ) endif if (.not. file_exists(fileName)) call MOM_error(FATAL,trim(mdl)// & ", initialize_regridding: "// & - "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(string)//")") + "Specified file not found: Looking for '"//trim(fileName)//"' ("//trim(longString)//")") do_sum = .false. - varName = trim( extractWord(trim(string(6:)), 2) ) + varName = trim( extractWord(trim(longString(6:)), 2) ) if (.not. field_exists(fileName,varName)) call MOM_error(FATAL,trim(mdl)// & ", initialize_regridding: "// & - "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(string)//")") + "Specified field not found: Looking for '"//trim(varName)//"' ("//trim(longString)//")") if (len_trim(varName)==0) then if (field_exists(fileName,'z_max')) then; varName = 'z_max' elseif (field_exists(fileName,'dz')) then; varName = 'dz' ; do_sum = .true. @@ -1079,15 +1079,15 @@ subroutine initialize_regridding(CS, G, GV, US, max_depth, param_file, mdl, & call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) - elseif (index(trim(string),'FNC1:')==1) then - call dz_function1( trim(string(6:)), dz_max ) + elseif (index(trim(longString),'FNC1:')==1) then + call dz_function1( trim(longString(6:)), dz_max ) z_max(1) = 0.0 ; do K=1,ke ; z_max(K+1) = z_max(K) + dz_max(K) ; enddo call log_param(param_file, mdl, "!MAXIMUM_INT_DEPTHS", z_max, & trim(message), units=coordinateUnits(coord_mode)) call set_regrid_max_depths(CS, z_max, GV%m_to_H) else call MOM_error(FATAL,trim(mdl)//", initialize_regridding: "// & - "Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(string)) + "Unrecognized MAXIMUM_INT_DEPTH_CONFIG "//trim(longString)) endif deallocate(z_max) deallocate(dz_max) diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 4b55700217..ca0dfe0145 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -36,6 +36,7 @@ module MOM use MOM_error_handler, only : MOM_set_verbosity, callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint use MOM_file_parser, only : read_param, get_param, log_version, param_file_type +use MOM_file_parser, only : openParameterBlock, closeParameterBlock use MOM_forcing_type, only : forcing, mech_forcing, find_ustar use MOM_forcing_type, only : MOM_forcing_chksum, MOM_mech_forcing_chksum use MOM_get_input, only : Get_MOM_Input, directories @@ -146,6 +147,7 @@ module MOM use MOM_tracer_registry, only : tracer_registry_type, register_tracer, tracer_registry_init use MOM_tracer_registry, only : register_tracer_diagnostics, post_tracer_diagnostics_at_sync use MOM_tracer_registry, only : post_tracer_transport_diagnostics, MOM_tracer_chksum +use MOM_tracer_registry, only : post_tracer_integral_diagnostics use MOM_tracer_registry, only : preALE_tracer_diagnostics, postALE_tracer_diagnostics use MOM_tracer_registry, only : lock_tracer_registry, tracer_registry_end use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_CS @@ -320,6 +322,10 @@ module MOM logical :: useMEKE !< If true, call the MEKE parameterization. logical :: use_stochastic_EOS !< If true, use the stochastic EOS parameterizations. logical :: useWaves !< If true, update Stokes drift + logical :: StokesMOST !< If true, use Stokes Similarity package. Needed to decide if Lam2 should + !! be passed to mixedlayer_restrat. + logical :: wave_enhanced_ustar !< If true, enhance ustar in Bodner23. Needed to decide if Lam2 should + !! be passed to mixedlayer_restrat. real :: dtbt_reset_period !< The time interval between dynamic recalculation of the !! barotropic time step [T ~> s]. If this is negative dtbt is never !! calculated, and if it is 0, dtbt is calculated every step. @@ -395,6 +401,15 @@ module MOM type(diag_grid_storage) :: diag_pre_sync !< The grid (thicknesses) before remapping type(diag_grid_storage) :: diag_pre_dyn !< The grid (thicknesses) before dynamics + logical :: accumulate_resolved_flux = .false. !< If true, accumulate resolved flux for tracers for diagnostics + !! separating the tracer flux due to resolved and parameterized flow + logical :: do_resolved_advection = .false. !< If true, calculate advection by resolved flow + logical :: do_param_advection = .false. !< If true, calculate advection by parameterized flow + real, allocatable, dimension(:,:,:) :: & + uhtr_resolved !< accumulated zonal thickness fluxes due to resolved flow to advect tracers [H L2 ~> m3 or kg] + real, allocatable, dimension(:,:,:) :: & + vhtr_resolved !< accumulated meridional thickness fluxes due to resolved flow to advect tracers [H L2 ~> m3 or kg] + ! The remainder of this type provides pointers to child module control structures. type(MOM_dyn_unsplit_CS), pointer :: dyn_unsplit_CSp => NULL() @@ -1048,6 +1063,8 @@ subroutine step_MOM(forces_in, fluxes_in, sfc_state, Time_start, time_int_in, CS CS%CDp, p_surf, CS%t_dyn_rel_diag, CS%diag_pre_sync,& G, GV, US, CS%diagnostics_CSp) call post_tracer_diagnostics_at_sync(CS%Tracer_reg, h, CS%diag_pre_sync, CS%diag, G, GV, CS%t_dyn_rel_diag) + call post_tracer_integral_diagnostics(G, GV, US, CS%Tracer_reg, h, CS%tv, CS%diag) + call diag_copy_diag_to_storage(CS%diag_pre_sync, h, CS%diag) if (showCallTree) call callTree_waypoint("finished calculate_diagnostic_fields (step_MOM)") call disable_averaging(CS%diag) @@ -1329,6 +1346,19 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_tr_adv, & endif ! -------------------------------------------------- end SPLIT + ! Accumulate resolved flux for tracer diagnostics + if (CS%accumulate_resolved_flux) then + !$OMP parallel do default(shared) + do k=1,nz + do j=js-2,je+2 ; do I=Isq-2,Ieq+2 + CS%uhtr_resolved(I,j,k) = CS%uhtr_resolved(I,j,k) + CS%uh(I,j,k)*dt + enddo ; enddo + do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 + CS%vhtr_resolved(i,J,k) = CS%vhtr_resolved(i,J,k) + CS%vh(i,J,k)*dt + enddo ; enddo + enddo + endif + if (CS%use_particles .and. CS%do_dynamics .and. (.not. CS%use_uh_particles)) then if (CS%thickness_diffuse_first) call MOM_error(WARNING,"particles_run: "//& "Thickness_diffuse_first is true and use_uh_particles is false. "//& @@ -1407,8 +1437,17 @@ subroutine step_MOM_dynamics(forces, p_surf_begin, p_surf_end, dt, dt_tr_adv, & CS%uhtr, CS%vhtr, G%HI, haloshift=0, unscale=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, CS%visc%h_ML, & - CS%visc%sfc_buoy_flx, CS%VarMix, G, GV, US, CS%mixedlayer_restrat_CSp) + if (CS%wave_enhanced_ustar .and. CS%StokesMOST) then + if (associated(CS%visc%Lam2)) then + 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, CS%visc%Lam2) + else + call MOM_error(FATAL,'step_MOM_dynamics:CS%visc%Lam2 not associated') + endif + else + 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) + endif call cpu_clock_end(id_clock_ml_restrat) call pass_var(h, G%Domain, clock=id_clock_pass, halo=CS%dyn_h_stencil) if (CS%debug) then @@ -1478,9 +1517,19 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) type(group_pass_type) :: pass_T_S integer :: halo_sz ! The size of a halo where data must be valid. logical :: x_first ! If true, advect tracers first in the x-direction, then y. + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & + uhtr_tmp ! Temp. variable for advecting with alternate volume fluxes [H L2 ~> m3 or kg] + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)) :: & + vhtr_tmp ! Temp. variable for advecting with alternate volume fluxes[H L2 ~> m3 or kg] + integer :: i, j, k, m, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + integer :: IsdB, IedB, JsdB, JedB logical :: showCallTree + showCallTree = callTree_showQuery() + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB + if (CS%debug) then call cpu_clock_begin(id_clock_other) call hchksum(h,"Pre-advection h", G%HI, haloshift=1, unscale=GV%H_to_MKS) @@ -1509,7 +1558,27 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) endif if (CS%debug) call MOM_tracer_chksum("Pre-advect ", CS%tracer_Reg, G) 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) + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first, flux_type=0) + + if (CS%do_resolved_advection) then + call advect_tracer(h, CS%uhtr_resolved, CS%vhtr_resolved, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first, flux_type=1) + endif + + if (CS%do_param_advection) then + !$OMP parallel do default(shared) + do k=1,nz + do j=js-2,je+2 ; do I=Isq-2,Ieq+2 + uhtr_tmp(I,j,k) = CS%uhtr(I,j,k) - CS%uhtr_resolved(I,j,k) + enddo ; enddo + do J=Jsq-2,Jeq+2 ; do i=is-2,ie+2 + vhtr_tmp(i,J,k) = CS%vhtr(i,J,k) - CS%vhtr_resolved(i,J,k) + enddo ; enddo + enddo + call advect_tracer(h, uhtr_tmp, vhtr_tmp, CS%OBC, CS%t_dyn_rel_adv, G, GV, US, & + CS%tracer_adv_CSp, CS%tracer_Reg, x_first_in=x_first, flux_type=2) + endif + 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, CS%visc, G, GV, US, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) @@ -1537,6 +1606,10 @@ subroutine step_MOM_tracer_dyn(CS, G, GV, US, h, Time_local) call cpu_clock_begin(id_clock_thermo) ; call cpu_clock_begin(id_clock_tracer) CS%uhtr(:,:,:) = 0.0 CS%vhtr(:,:,:) = 0.0 + if (CS%accumulate_resolved_flux) then + CS%uhtr_resolved(:,:,:) = 0.0 + CS%vhtr_resolved(:,:,:) = 0.0 + endif CS%n_dyn_steps_in_adv = 0 CS%t_dyn_rel_adv = 0.0 call cpu_clock_end(id_clock_tracer) ; call cpu_clock_end(id_clock_thermo) @@ -1670,7 +1743,7 @@ subroutine step_MOM_thermo(CS, G, GV, US, u, v, h, tv, fluxes, dtdia, & fluxes%fluxes_used = .true. if (CS%stoch_CS%do_skeb) then - call apply_skeb(CS%G,CS%GV,CS%stoch_CS,CS%u,CS%v,CS%h,CS%tv,dtdia,Time_end_thermo) + call apply_skeb(G, GV, US, CS%stoch_CS, u, v, h, tv, dtdia, Time_end_thermo) endif if (showCallTree) call callTree_waypoint("finished diabatic (step_MOM_thermo)") @@ -2252,7 +2325,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & ! This include declares and sets the variable "version". # include "version_variable.h" - integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB real :: dtbt ! If negative, this specifies the barotropic timestep as a fraction ! of the maximum stable value [nondim]. @@ -2395,12 +2468,19 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & call get_param(param_file, '', "FPMIX", fpmix, & "If true, add non-local momentum flux increments and diffuse down the Eulerian gradient.", & default=.false., do_not_log=.true.) - if (fpmix .and. .not. CS%split) then call MOM_error(FATAL, "initialize_MOM: "//& "FPMIX=True only works when SPLIT=True.") endif - + call openParameterBlock(param_file, 'KPP', do_not_log=.true.) + call get_param(param_file, '', 'STOKES_MOST', CS%StokesMOST, & + 'If True, use Stokes Similarity package.', & + default=.False., do_not_log=.true.) + call closeParameterBlock(param_file) + call openParameterBlock(param_file,'MLE', do_not_log=.true.) + call get_param(param_file, '', "WAVE_ENHANCED_USTAR", CS%wave_enhanced_ustar, & + "If true, enhance ustar in Bodner23.", default=.false., do_not_log=.true.) + call closeParameterBlock(param_file) call get_param(param_file, "MOM", "BOUSSINESQ", Boussinesq, & "If true, make the Boussinesq approximation.", default=.true., do_not_log=.true.) call get_param(param_file, "MOM", "SEMI_BOUSSINESQ", semi_Boussinesq, & @@ -3629,6 +3709,25 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & call ALE_register_diags(Time, G, GV, US, diag, CS%ALE_CSp) endif + ! determine if we need to accumulate resolved transports for tracer advection diagnostics + do m = 1,CS%tracer_Reg%ntr + if (CS%tracer_Reg%Tr(m)%id_adx_resolved > 0 .or. & + CS%tracer_Reg%Tr(m)%id_ady_resolved > 0) then + CS%accumulate_resolved_flux = .true. + CS%do_resolved_advection = .true. + endif + if (CS%tracer_Reg%Tr(m)%id_adx_param > 0 .or. & + CS%tracer_Reg%Tr(m)%id_ady_param > 0) then + CS%accumulate_resolved_flux = .true. + CS%do_param_advection = .true. + endif + enddo + if (CS%accumulate_resolved_flux) then + allocate(CS%uhtr_resolved(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(CS%vhtr_resolved(isd:ied,JsdB:JedB,nz), source=0.0) + endif + + ! Do any necessary halo updates on any auxiliary variables that have been initialized. call cpu_clock_begin(id_clock_pass_init) if (associated(CS%visc%Kv_shear)) & @@ -3709,7 +3808,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, & endif ! initialize stochastic physics - call stochastics_init(CS%dt_therm, CS%G, CS%GV, CS%stoch_CS, param_file, diag, Time) + call stochastics_init(CS%dt_therm, CS%G, CS%GV, US, CS%stoch_CS, param_file, diag, Time) call callTree_leave("initialize_MOM()") call cpu_clock_end(id_clock_init) @@ -4522,6 +4621,9 @@ subroutine MOM_end(CS) DEALLOC_(CS%uhtr) ; DEALLOC_(CS%vhtr) + if (allocated(CS%uhtr_resolved)) deallocate(CS%uhtr_resolved) + if (allocated(CS%vhtr_resolved)) deallocate(CS%vhtr_resolved) + if (associated(CS%Hml)) deallocate(CS%Hml) if (associated(CS%tv%salt_deficit)) deallocate(CS%tv%salt_deficit) if (associated(CS%tv%frazil)) deallocate(CS%tv%frazil) diff --git a/src/core/MOM_PressureForce_FV.F90 b/src/core/MOM_PressureForce_FV.F90 index c118d17f21..b0e1934229 100644 --- a/src/core/MOM_PressureForce_FV.F90 +++ b/src/core/MOM_PressureForce_FV.F90 @@ -2032,8 +2032,6 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL type(tidal_forcing_CS), intent(in), target, optional :: tides_CSp !< Tides control structure ! Local variables - real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale - ! temperature variance [nondim] integer :: default_answer_date ! Global answer date logical :: use_temperature ! If true, temperature and salinity are used as state variables. logical :: use_EOS ! If true, density calculated from T & S using an equation of state. @@ -2047,6 +2045,7 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL # include "version_variable.h" character(len=40) :: mdl ! This module's name. logical :: use_ALE ! If true, use the Vertical Lagrangian Remap algorithm + logical :: stoch_eos ! Can't use Stanley param here unless stoch_eos is true integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = GV%ke @@ -2191,16 +2190,15 @@ subroutine PressureForce_FV_init(Time, G, GV, US, param_file, diag, CS, ADp, SAL "boundary cells is extrapolated, rather than using PCM "//& "in these cells. If true, the same order polynomial is "//& "used as is used for the interior cells.", default=.true.) + call get_param(param_file, mdl, "STOCH_EOS", stoch_eos, & + default=.false., do_not_log=.true.) call get_param(param_file, mdl, "USE_STANLEY_PGF", CS%use_stanley_pgf, & "If true, turn on Stanley SGS T variance parameterization "// & "in PGF code.", default=.false.) if (CS%use_stanley_pgf) then - call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & - "Coefficient correlating the temperature gradient and SGS T variance.", & - units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) call MOM_error(FATAL, & - "STANLEY_COEFF must be set >= 0 if USE_STANLEY_PGF is true.") - + if (.not.stoch_eos) then + call MOM_error(FATAL, "PressureForce_FV_init: USE_STANLEY_PGF requires STOCH_EOS") + endif CS%id_rho_pgf = register_diag_field('ocean_model', 'rho_pgf', diag%axesTL, & Time, 'rho in PGF', 'kg m-3', conversion=US%R_to_kg_m3) CS%id_rho_stanley_pgf = register_diag_field('ocean_model', 'rho_stanley_pgf', diag%axesTL, & diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index 8ebf5f7180..34ac8be444 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -236,7 +236,12 @@ module MOM_forcing_type atm_co2 => NULL(), & !< Atmospheric CO2 Concentration [ppm] atm_alt_co2 => NULL(), & !< Alternate atmospheric CO2 Concentration [ppm] dust_flux => NULL(), & !< Flux of dust into the ocean [R Z T-1 ~> kgN m-2 s-1] - iron_flux => NULL() !< Flux of dust into the ocean [conc Z T-1 ~> conc m s-1] + iron_flux => NULL(), & !< Flux of dust into the ocean [conc Z T-1 ~> conc m s-1] + atm_fine_dust_flux => NULL(), & !< Fine dust flux from atmosphere [R Z T-1 ~> kg m-2 s-1] + atm_coarse_dust_flux => NULL(), & !< Coarse dust flux from atmosphere [R Z T-1 ~> kg m-2 s-1] + seaice_dust_flux => NULL(), & !< Dust flux from seaice [R Z T-1 ~> kg m-2 s-1] + atm_bc_flux => NULL(), & !< Black carbon flux from atmosphere [R Z T-1 ~> kg m-2 s-1] + seaice_bc_flux => NULL() !< Black carbon flux from seaice [R Z T-1 ~> kg m-2 s-1] real, pointer, dimension(:,:,:) :: & fracr_cat => NULL(), & !< per-category ice fraction [nondim] @@ -423,6 +428,11 @@ module MOM_forcing_type ! tracer surface flux related diagnostics handles integer :: id_ice_fraction = -1 integer :: id_u10_sqr = -1 + integer :: id_atm_fine_dust_flux = -1 + integer :: id_atm_coarse_dust_flux = -1 + integer :: id_atm_bc_flux = -1 + integer :: id_seaice_dust_flux = -1 + integer :: id_seaice_bc_flux = -1 ! iceberg diagnostic handles integer :: id_ustar_berg = -1 @@ -1061,6 +1071,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt real :: H_limit_fluxes ! A depth scale that specifies when the ocean is shallow that ! it is necessary to eliminate fluxes [H ~> m or kg m-2] integer :: i, k + type(thermo_var_ptrs) :: tv_rate ! local copy for rate-only call to extractFluxes1d ! smg: what do we do when have heat fluxes from calving and river? useRiverHeatContent = .False. @@ -1068,6 +1079,10 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt H_limit_fluxes = max( GV%Angstrom_H, 1.e-30*GV%m_to_H ) + ! Do not update tv%TempxPmE in the diagnostic for the rate-only call to extractFluxes1d + tv_rate = tv + tv_rate%TempxPmE => null() + ! The surface forcing is contained in the fluxes type. ! We aggregate the thermodynamic forcing for a time step into the following: ! netH = water added/removed via surface fluxes [H T-1 ~> m s-1 or kg m-2 s-1] @@ -1078,7 +1093,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, US, fluxes, optics, nsw, h, Temp, Salt call extractFluxes1d(G, GV, US, fluxes, optics, nsw, j, 1.0, & H_limit_fluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & - netSalt, penSWbnd, tv, .false.) + netSalt, penSWbnd, tv_rate, .false.) ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth @@ -1542,7 +1557,7 @@ end subroutine forcing_SinglePointPrint !> Register members of the forcing type for diagnostics subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, use_berg_fluxes, use_waves, & - use_cfcs, use_glc_runoff) + use_cfcs, use_MARBL_tracers, use_glc_runoff) type(time_type), intent(in) :: Time !< time type type(diag_ctrl), intent(inout) :: diag !< diagnostic control type type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type @@ -1551,8 +1566,18 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, logical, optional, intent(in) :: use_berg_fluxes !< If true, allow iceberg flux diagnostics logical, optional, intent(in) :: use_waves !< If true, allow wave forcing diagnostics logical, optional, intent(in) :: use_cfcs !< If true, allow cfc related diagnostics + logical, optional, intent(in) :: use_MARBL_tracers !< If true, allow MARBL related diagnostics logical, optional, intent(in) :: use_glc_runoff !< If true, allow separate glacial runoff diagnostics + logical :: use_cfcs_or_MARBL_tracers + + ! some diagnostics should be registered if either cfc or MARBL tracers are enabled + use_cfcs_or_MARBL_tracers = .false. + if (present(use_cfcs)) & + use_cfcs_or_MARBL_tracers = use_cfcs_or_MARBL_tracers .or. use_cfcs + if (present(use_MARBL_tracers)) & + use_cfcs_or_MARBL_tracers = use_cfcs_or_MARBL_tracers .or. use_MARBL_tracers + ! Clock for forcing diagnostics handles%id_clock_forcing=cpu_clock_id('(Ocean forcing diagnostics)', grain=CLOCK_ROUTINE) @@ -1601,17 +1626,34 @@ subroutine register_forcing_type_diags(Time, diag, US, use_temperature, handles, endif endif - ! See: - if (present(use_cfcs)) then - if (use_cfcs) then - handles%id_ice_fraction = register_diag_field('ocean_model', 'ice_fraction', diag%axesT1, Time, & - 'Fraction of cell area covered by sea ice', 'm2 m-2', conversion=1.0) + if (use_cfcs_or_MARBL_tracers) then + handles%id_ice_fraction = register_diag_field('ocean_model', 'ice_fraction', diag%axesT1, Time, & + 'Fraction of cell area covered by sea ice', 'm2 m-2', conversion=1.0) - handles%id_u10_sqr = register_diag_field('ocean_model', 'u10_sqr', diag%axesT1, Time, & - 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%L_to_m**2*US%s_to_T**2) - endif + handles%id_u10_sqr = register_diag_field('ocean_model', 'u10_sqr', diag%axesT1, Time, & + 'Wind magnitude at 10m, squared', 'm2 s-2', conversion=US%L_to_m**2*US%s_to_T**2) endif + if (present(use_MARBL_tracers)) then + if (use_MARBL_tracers) then + handles%id_atm_fine_dust_flux = register_diag_field('ocean_model', 'ATM_FINE_DUST_FLUX_CPL', & + diag%axesT1, Time, 'ATM_FINE_DUST_FLUX from cpl', 'kg m-2 s', & + conversion=US%RZ_T_to_kg_m2s) + handles%id_atm_coarse_dust_flux = register_diag_field('ocean_model', 'ATM_COARSE_DUST_FLUX_CPL', & + diag%axesT1, Time, 'ATM_COARSE_DUST_FLUX from cpl', 'kg m-2 s', & + conversion=US%RZ_T_to_kg_m2s) + handles%id_atm_bc_flux = register_diag_field('ocean_model', 'ATM_BLACK_CARBON_FLUX_CPL', & + diag%axesT1, Time, 'ATM_BLACK_CARBON_FLUX from cpl', 'kg m-2 s', & + conversion=US%RZ_T_to_kg_m2s) + + handles%id_seaice_dust_flux = register_diag_field('ocean_model', 'SEAICE_DUST_FLUX_CPL', & + diag%axesT1, Time, 'SEAICE_DUST_FLUX from cpl', 'kg m-2 s', & + conversion=US%RZ_T_to_kg_m2s) + handles%id_seaice_bc_flux = register_diag_field('ocean_model', 'SEAICE_BLACK_CARBON_FLUX_CPL', & + diag%axesT1, Time, 'SEAICE_BLACK_CARBON_FLUX from cpl', 'kg m-2 s', & + conversion=US%RZ_T_to_kg_m2s) + end if + end if handles%id_psurf = register_diag_field('ocean_model', 'p_surf', diag%axesT1, Time, & 'Pressure at ice-ocean or atmosphere-ocean interface', & 'Pa', conversion=US%RL2_T2_to_Pa, cmor_field_name='pso', & @@ -2340,7 +2382,7 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) ! applied based on the time interval stored in flux_tmp. real :: wt1 ! The relative weight of the previous fluxes [nondim] - integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, n integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -2501,6 +2543,84 @@ subroutine fluxes_accumulate(flux_tmp, fluxes, G, wt2, forces) enddo ; enddo endif + ! Forcings introduced for MARBL + ! NOTE: fluxes%salt_flux, %sw, and %p_surf_full are handled above + if (associated(fluxes%nhx_dep) .and. associated(flux_tmp%nhx_dep)) then + do j=jsd,jed ; do i=isd,ied + fluxes%nhx_dep(i,j) = wt1*fluxes%nhx_dep(i,j) + wt2*flux_tmp%nhx_dep(i,j) + enddo ; enddo + endif + if (associated(fluxes%noy_dep) .and. associated(flux_tmp%noy_dep)) then + do j=jsd,jed ; do i=isd,ied + fluxes%noy_dep(i,j) = wt1*fluxes%noy_dep(i,j) + wt2*flux_tmp%noy_dep(i,j) + enddo ; enddo + endif + if (associated(fluxes%atm_co2) .and. associated(flux_tmp%atm_co2)) then + do j=jsd,jed ; do i=isd,ied + fluxes%atm_co2(i,j) = wt1*fluxes%atm_co2(i,j) + wt2*flux_tmp%atm_co2(i,j) + enddo ; enddo + endif + if (associated(fluxes%atm_alt_co2) .and. associated(flux_tmp%atm_alt_co2)) then + do j=jsd,jed ; do i=isd,ied + fluxes%atm_alt_co2(i,j) = wt1*fluxes%atm_alt_co2(i,j) + wt2*flux_tmp%atm_alt_co2(i,j) + enddo ; enddo + endif + if (associated(fluxes%dust_flux) .and. associated(flux_tmp%dust_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%dust_flux(i,j) = wt1*fluxes%dust_flux(i,j) + wt2*flux_tmp%dust_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%iron_flux) .and. associated(flux_tmp%iron_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%iron_flux(i,j) = wt1*fluxes%iron_flux(i,j) + wt2*flux_tmp%iron_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%atm_fine_dust_flux) .and. associated(flux_tmp%atm_fine_dust_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%atm_fine_dust_flux(i,j) = wt1*fluxes%atm_fine_dust_flux(i,j) + wt2*flux_tmp%atm_fine_dust_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%atm_coarse_dust_flux) .and. associated(flux_tmp%atm_coarse_dust_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%atm_coarse_dust_flux(i,j) = wt1*fluxes%atm_coarse_dust_flux(i,j) + wt2*flux_tmp%atm_coarse_dust_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%atm_bc_flux) .and. associated(flux_tmp%atm_bc_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%atm_bc_flux(i,j) = wt1*fluxes%atm_bc_flux(i,j) + wt2*flux_tmp%atm_bc_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%seaice_dust_flux) .and. associated(flux_tmp%seaice_dust_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%seaice_dust_flux(i,j) = wt1*fluxes%seaice_dust_flux(i,j) + wt2*flux_tmp%seaice_dust_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%seaice_bc_flux) .and. associated(flux_tmp%seaice_bc_flux)) then + do j=jsd,jed ; do i=isd,ied + fluxes%seaice_bc_flux(i,j) = wt1*fluxes%seaice_bc_flux(i,j) + wt2*flux_tmp%seaice_bc_flux(i,j) + enddo ; enddo + endif + if (associated(fluxes%fracr_cat) .and. associated(flux_tmp%fracr_cat)) then + do n=1,size(fluxes%fracr_cat,dim=3) ; do j=jsd,jed ; do i=isd,ied + fluxes%fracr_cat(i,j,n) = wt1*fluxes%fracr_cat(i,j,n) + wt2*flux_tmp%fracr_cat(i,j,n) + enddo ; enddo ; enddo + endif + if (associated(fluxes%qsw_cat) .and. associated(flux_tmp%qsw_cat)) then + do n=1,size(fluxes%qsw_cat,dim=3) ; do j=jsd,jed ; do i=isd,ied + fluxes%qsw_cat(i,j,n) = wt1*fluxes%qsw_cat(i,j,n) + wt2*flux_tmp%qsw_cat(i,j,n) + enddo ; enddo ; enddo + endif + if (associated(fluxes%ice_fraction) .and. associated(flux_tmp%ice_fraction)) then + do j=jsd,jed ; do i=isd,ied + fluxes%ice_fraction(i,j) = wt1*fluxes%ice_fraction(i,j) + wt2*flux_tmp%ice_fraction(i,j) + enddo ; enddo + endif + if (associated(fluxes%u10_sqr) .and. associated(flux_tmp%u10_sqr)) then + do j=jsd,jed ; do i=isd,ied + fluxes%u10_sqr(i,j) = wt1*fluxes%u10_sqr(i,j) + wt2*flux_tmp%u10_sqr(i,j) + enddo ; enddo + endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & coupler_type_initialized(flux_tmp%tr_fluxes)) & call coupler_type_increment_data(flux_tmp%tr_fluxes, fluxes%tr_fluxes, & @@ -3368,6 +3488,21 @@ subroutine forcing_diagnostics(fluxes_in, sfc_state, G_in, US, time_end, diag, h if ((handles%id_u10_sqr > 0) .and. associated(fluxes%u10_sqr)) & call post_data(handles%id_u10_sqr, fluxes%u10_sqr, diag) + if ((handles%id_atm_fine_dust_flux > 0) .and. associated(fluxes%atm_fine_dust_flux)) & + call post_data(handles%id_atm_fine_dust_flux, fluxes%atm_fine_dust_flux, diag) + + if ((handles%id_atm_coarse_dust_flux > 0) .and. associated(fluxes%atm_coarse_dust_flux)) & + call post_data(handles%id_atm_coarse_dust_flux, fluxes%atm_coarse_dust_flux, diag) + + if ((handles%id_atm_bc_flux > 0) .and. associated(fluxes%atm_bc_flux)) & + call post_data(handles%id_atm_bc_flux, fluxes%atm_bc_flux, diag) + + if ((handles%id_seaice_dust_flux > 0) .and. associated(fluxes%seaice_dust_flux)) & + call post_data(handles%id_seaice_dust_flux, fluxes%seaice_dust_flux, diag) + + if ((handles%id_seaice_bc_flux > 0) .and. associated(fluxes%seaice_bc_flux)) & + call post_data(handles%id_seaice_bc_flux, fluxes%seaice_bc_flux, diag) + ! remaining boundary terms ================================================== if ((handles%id_psurf > 0) .and. associated(fluxes%p_surf)) & @@ -3528,7 +3663,7 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & if (present(fix_accum_bug)) fluxes%gustless_accum_bug = .not.fix_accum_bug - !These fields should only be allocated when USE_MARBL is activated. + !These fields should only be allocated when USE_MARBL_TRACERS is activated. call myAlloc(fluxes%ice_fraction,isd,ied,jsd,jed, marbl) call myAlloc(fluxes%u10_sqr,isd,ied,jsd,jed, marbl) call myAlloc(fluxes%noy_dep,isd,ied,jsd,jed, marbl) @@ -3537,6 +3672,11 @@ subroutine allocate_forcing_by_group(G, fluxes, water, heat, ustar, press, & call myAlloc(fluxes%atm_alt_co2,isd,ied,jsd,jed, marbl) call myAlloc(fluxes%dust_flux,isd,ied,jsd,jed, marbl) call myAlloc(fluxes%iron_flux,isd,ied,jsd,jed, marbl) + call myAlloc(fluxes%atm_fine_dust_flux,isd,ied,jsd,jed, marbl) + call myAlloc(fluxes%atm_coarse_dust_flux,isd,ied,jsd,jed, marbl) + call myAlloc(fluxes%atm_bc_flux,isd,ied,jsd,jed, marbl) + call myAlloc(fluxes%seaice_dust_flux,isd,ied,jsd,jed, marbl) + call myAlloc(fluxes%seaice_bc_flux,isd,ied,jsd,jed, marbl) ! These fields should only be allocated when receiving multiple ice categories if (present(ice_ncat)) then @@ -3843,6 +3983,11 @@ subroutine deallocate_forcing_type(fluxes) if (associated(fluxes%atm_alt_co2)) deallocate(fluxes%atm_alt_co2) if (associated(fluxes%dust_flux)) deallocate(fluxes%dust_flux) if (associated(fluxes%iron_flux)) deallocate(fluxes%iron_flux) + if (associated(fluxes%atm_fine_dust_flux)) deallocate(fluxes%atm_fine_dust_flux) + if (associated(fluxes%atm_coarse_dust_flux)) deallocate(fluxes%atm_coarse_dust_flux) + if (associated(fluxes%atm_bc_flux)) deallocate(fluxes%atm_bc_flux) + if (associated(fluxes%seaice_dust_flux)) deallocate(fluxes%seaice_dust_flux) + if (associated(fluxes%seaice_bc_flux)) deallocate(fluxes%seaice_bc_flux) if (associated(fluxes%fracr_cat)) deallocate(fluxes%fracr_cat) if (associated(fluxes%qsw_cat)) deallocate(fluxes%qsw_cat) diff --git a/src/core/MOM_stoch_eos.F90 b/src/core/MOM_stoch_eos.F90 index f10a06fb51..b312cc3a39 100644 --- a/src/core/MOM_stoch_eos.F90 +++ b/src/core/MOM_stoch_eos.F90 @@ -7,7 +7,7 @@ module MOM_stoch_eos use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl use MOM_error_handler, only : MOM_error, FATAL -use MOM_file_parser, only : get_param, param_file_type +use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_isopycnal_slopes, only : vert_fill_TS @@ -65,27 +65,32 @@ logical function MOM_stoch_eos_init(Time, G, GV, US, param_file, diag, CS, resta type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! local variables + ! This include declares and sets the variable "version". +# include "version_variable.h" integer :: i,j MOM_stoch_eos_init = .false. CS%seed = 0 + call log_version(param_file, "MOM_stoch_eos", version, "") call get_param(param_file, "MOM_stoch_eos", "STOCH_EOS", CS%use_stoch_eos, & - "If true, stochastic perturbations are applied "//& - "to the EOS in the PGF.", default=.false.) + "If true, computes stochastic perturbations that can be applied "//& + "to the EOS in various places.", default=.false.) call get_param(param_file, "MOM_stoch_eos", "STANLEY_COEFF", CS%stanley_coeff, & "Coefficient correlating the temperature gradient "//& "and SGS T variance.", units="nondim", default=-1.0) + if ((CS%stanley_coeff < 0.0) .and. CS%use_stoch_eos) call MOM_error(FATAL, & + "STANLEY_COEFF must be set >= 0 if STOCH_EOS is true.") call get_param(param_file, "MOM_stoch_eos", "STANLEY_A", CS%stanley_a, & "Coefficient a which scales chi in stochastic perturbation of the "//& "SGS T variance.", units="nondim", default=1.0, & - do_not_log=((CS%stanley_coeff<0.0) .or. .not.CS%use_stoch_eos)) + do_not_log=.not.CS%use_stoch_eos) call get_param(param_file, "MOM_stoch_eos", "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & units="m2 s-1", default=1.0e-6, scale=GV%m2_s_to_HZ_T, & - do_not_log=(CS%stanley_coeff<0.0)) + do_not_log=.not.CS%use_stoch_eos) ! Don't run anything if STANLEY_COEFF < 0 if (CS%stanley_coeff >= 0.0) then @@ -261,4 +266,30 @@ subroutine MOM_calc_varT(G, GV, US, h, tv, CS, dt) endif end subroutine MOM_calc_varT +!> \namespace mom_stoch_eos +!! +!! This module provides the foundation of the Stanley parameterization (\cite stanley2020) for correcting the +!! computation of density. Density is not a prognostic variable in MOM6; it is computed for various purposes +!! in various places. The correction to this calculation provided by this module has been implemented +!! in some places where density is used, but not all. +!! +!! To use the correction, first set STOCH_EOS=True. Then, choose the constant c from (25) of +!! \cite stanley2020. This is controlled using STANLEY_COEFF. Setting a negative value will +!! result in an error. \cite stanley2020 found a value of 0.2 offline, coarsening from 0.1 to 1 degree +!! resolution. \cite kenigson2022 proposed a value of 0.5 in a 2/3 degree resolution model. +!! +!! Whether the correction is deterministic or stochastic can be controlled using the variable +!! STANLEY_A. Setting this to 0.0 uses the deterministic version, while a value of 1.0 produces +!! the stochastic version. Reducing from 1 to 0 smoothly transitions from stochastic to deterministic. +!! +!! To turn the correction on in various parts of the code, use +!! - USE_STANLEY_PGF=True for the pressure gradient force (cf. \cite kenigson2022) +!! - USE_STANLEY_ISO=True to correct the computation of isopycnal slopes (used in many places) +!! - USE_STANLEY_GM=True to use the parameterization within GM (cf. \cite agarwal2023) +!! - USE_STANLEY_ML=True to use the parameterization within the mixed-layer restratification +!! parameterization. It applies to both the OM4 and Bodner schemes. (cf. \cite agarwal2023) +!! +!! For ensemble simulations, the random number generator seed can be controlled using the parameter +!! SEED_STOCH_EOS + end module MOM_stoch_eos diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 875cbb4693..c43f71481e 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -293,6 +293,7 @@ module MOM_variables ! 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(:,:) :: Lam2 => NULL() !< (Langmuir Number)^-2 [nondim]. 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() @@ -367,7 +368,7 @@ module MOM_variables !! the ocean model. Unused fields are unallocated. subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & gas_fields_ocn, use_meltpot, use_iceshelves, & - omit_frazil, sfc_state_in, turns, use_marbl_tracers) + omit_frazil, sfc_state_in, turns, use_MARBL_tracers) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(surface), intent(inout) :: sfc_state !< ocean surface state type to be allocated. logical, optional, intent(in) :: use_temperature !< If true, allocate the space for thermodynamic variables. @@ -393,7 +394,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & !! is present, it is used and tr_fields_in is ignored. integer, optional, intent(in) :: turns !< If present, the number of counterclockwise quarter !! turns to use on the new grid. - logical, optional, intent(in) :: use_marbl_tracers !< If true, allocate the space for CO2 flux from MARBL + logical, optional, intent(in) :: use_MARBL_tracers !< If true, allocate the space for CO2 flux from MARBL ! local variables logical :: use_temp, alloc_integ, use_melt_potential, alloc_iceshelves, alloc_frazil, alloc_fco2 @@ -411,7 +412,7 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & use_melt_potential = .false. ; if (present(use_meltpot)) use_melt_potential = use_meltpot alloc_iceshelves = .false. ; if (present(use_iceshelves)) alloc_iceshelves = use_iceshelves alloc_frazil = .true. ; if (present(omit_frazil)) alloc_frazil = .not.omit_frazil - alloc_fco2 = .false. ; if (present(use_marbl_tracers)) alloc_fco2 = use_marbl_tracers + alloc_fco2 = .false. ; if (present(use_MARBL_tracers)) alloc_fco2 = use_MARBL_tracers if (sfc_state%arrays_allocated) return diff --git a/src/diagnostics/MOM_diagnose_MLD.F90 b/src/diagnostics/MOM_diagnose_MLD.F90 index b2b231cb37..b24714ba69 100644 --- a/src/diagnostics/MOM_diagnose_MLD.F90 +++ b/src/diagnostics/MOM_diagnose_MLD.F90 @@ -103,7 +103,7 @@ subroutine diagnoseMLDbyDensityDifference(id_MLD, h, tv, densityDiff, G, GV, US, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke hRef_MLD(:) = ref_h_mld - pRef_MLD(:) = GV%H_to_RZ*GV%g_Earth*ref_h_mld + pRef_MLD(:) = GV%H_to_RZ * GV%Z_to_H * GV%g_Earth * ref_h_mld z_ref_diag(:,:) = 0. EOSdom(:) = EOS_domain(G%HI) @@ -337,6 +337,7 @@ subroutine diagnoseMLDbyEnergy(id_MLD, h, tv, G, GV, US, Mixing_Energy, k_bounds is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + use_OM4_iteration = .false. if (present(OM4_iteration)) then use_OM4_iteration = OM4_iteration endif diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index fba33fe0ee..9f37965874 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -1100,7 +1100,8 @@ subroutine accumulate_net_input(fluxes, sfc_state, tv, dt, G, US, CS) heat_in(i,j) = heat_in(i,j) + dt * G%areaT(i,j) * & (fluxes%heat_content_evap(i,j) + fluxes%heat_content_lprec(i,j) + & fluxes%heat_content_cond(i,j) + fluxes%heat_content_fprec(i,j) + & - fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j)) + fluxes%heat_content_lrunoff(i,j) + fluxes%heat_content_frunoff(i,j) + & + fluxes%heat_content_lrunoff_glc(i,j) + fluxes%heat_content_frunoff_glc(i,j)) enddo ; enddo elseif (associated(tv%TempxPmE)) then do j=js,je ; do i=is,ie diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index d8a528f5bf..859072c9d6 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -108,6 +108,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! Local variables integer, dimension(2) :: layout ! The number of logical processors in the i- and j- directions integer, dimension(2) :: auto_layout ! The layout determined by the auto masking routine + integer, dimension(2) :: auto_io_layout ! The IO layout determined by the auto masking routine integer, dimension(2) :: layout_unmasked ! A temporary layout for unmasked domain integer, dimension(2) :: io_layout ! The layout of logical processors for input and output !$ integer :: ocean_nthreads ! Number of openMP threads @@ -125,6 +126,7 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! width of the halos that are updated with each call. logical :: auto_mask_table ! Runtime flag that turns on automatic mask table generator integer :: auto_io_layout_fac ! Used to compute IO layout when auto_mask_table is True. + integer :: target_io_pes ! Target number of IO PEs for when auto_mask_table is True. logical :: mask_table_exists ! True if there is a mask table file logical :: is_MOM_domain ! True if this domain is being set for MOM, and not another component like SIS2. character(len=128) :: inputdir ! The directory in which to find the diag table @@ -326,13 +328,22 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & id_clock_auto_mask = cpu_clock_id('(Ocean gen_auto_mask_table)', grain=CLOCK_ROUTINE) auto_mask_table_fname = "MOM_auto_mask_table" + call get_param(param_file, mdl, "TARGET_IO_PES", target_io_pes, & + "When AUTO_MASKTABLE is enabled, target number of IO PEs. If the given target number "//& + "of IO PEs is not achievable, the target number of IO PEs is set to the nearest smaller "//& + "number of PEs that is achievable.", default=1, layoutParam=.true.) + if (target_io_pes <= 0) then + call MOM_error(FATAL, 'TARGET_IO_PES must be a nonnegative integer.') + endif + ! Auto-generate a mask file and determine the layout call cpu_clock_begin(id_clock_auto_mask) if (is_root_PE()) then call gen_auto_mask_table(n_global, reentrant, tripolar_N, PEs_used, param_file, inputdir, & - auto_mask_table_fname, auto_layout, US) + auto_mask_table_fname, target_io_pes, auto_layout, auto_io_layout, US) endif call broadcast(auto_layout, length=2) + call broadcast(auto_io_layout, length=2) call cpu_clock_end(id_clock_auto_mask) mask_table = auto_mask_table_fname @@ -425,12 +436,20 @@ subroutine MOM_domains_init(MOM_dom, param_file, symmetric, static_memory, & ! Compute a valid IO layout if auto_mask_table is on. Otherwise, read in IO_LAYOUT parameter, if (auto_mask_table) then + ! aa: AUTO_IO_LAYOUT_FAC is fragile and should be deprecated/removed in favor of TARGET_IO_PES. call get_param(param_file, mdl, "AUTO_IO_LAYOUT_FAC", auto_io_layout_fac, & "When AUTO_MASKTABLE is enabled, io layout is calculated by performing integer "//& "division of the runtime-determined domain layout with this factor. If the factor "//& - "is set to 0 (default), the io layout is set to 1,1.", & + "is set to 0 (default), the io layout is set to 1,1. NOTE: TARGET_IO_PES is a more "//& + "robust way to set the number of IO PEs when auto masking is turned on.", & default=0, layoutParam=.true.) - if (auto_io_layout_fac>0) then + if (auto_io_layout_fac>1 .and. target_io_pes>1) then + call MOM_error(FATAL, 'AUTO_IO_LAYOUT_FAC and TARGET_IO_PES cannot be set simultaneously.') + endif + if (target_io_pes>1) then + io_layout(1) = auto_io_layout(1) + io_layout(2) = auto_io_layout(2) + elseif (auto_io_layout_fac>0) then io_layout(1) = max(layout(1)/auto_io_layout_fac, 1) io_layout(2) = max(layout(2)/auto_io_layout_fac, 1) elseif (auto_io_layout_fac<0) then @@ -486,7 +505,8 @@ subroutine MOM_define_layout(n_global, ndivs, layout) end subroutine MOM_define_layout !> Given a desired number of active npes, generate a layout and mask_table -subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file, inputdir, filename, layout, US) +subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file, & + inputdir, filename, target_io_pes, layout, io_layout, US) integer, dimension(2), intent(in) :: n_global !< The total number of gridpoints in 2 directions logical, dimension(2), intent(in) :: reentrant !< True if the x- and y- directions are periodic. logical, intent(in) :: tripolar_N !< A flag indicating whether there is n. tripolar connectivity @@ -494,7 +514,9 @@ subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters character(len=128), intent(in) :: inputdir !< INPUTDIR parameter character(len=:), allocatable, intent(in) :: filename !< Mask table file path (to be auto-generated.) + integer, intent(inout) :: target_io_pes !< Target number of IO PEs when auto_mask_table is True. integer, dimension(2), intent(out) :: layout !< The generated layout of PEs (incl. masked blocks) + integer, dimension(2), intent(out) :: io_layout !< The generated IO layout based on target_io_pes. type(unit_scale_type), optional, pointer :: US !< A dimensional unit scaling type ! Local variables @@ -504,21 +526,27 @@ subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file character(len=200) :: topo_varname ! Variable name in file character(len=200) :: topo_config character(len=40) :: mdl = "gen_auto_mask_table" ! This subroutine's name. - integer :: i, j, p + integer :: i, j, p, p_up real :: Dmask ! The depth for masking in the same units as D [Z ~> m] real :: min_depth ! The minimum ocean depth in the same units as D [Z ~> m] real :: mask_depth ! The depth shallower than which to mask a point as land. [Z ~> m] real :: glob_ocn_frac ! ratio of ocean points to total number of points [nondim] - real :: r_p ! aspect ratio for division count p. [nondim] + real :: ar ! layout aspect ratio to check if it is too extreme [nondim] real :: m_to_Z ! A conversion factor from m to height units [Z m-1 ~> 1] integer :: nx, ny ! global domain sizes integer, parameter :: ibuf=2, jbuf=2 real, parameter :: r_extreme = 4.0 ! aspect ratio limit (>1) for a layout to be considered [nondim] integer :: num_masked_blocks integer, allocatable :: mask_table(:,:) + integer :: max_feasible_p ! max division count that leads to enough land block masking to arrive at target compute PEs + real, parameter :: pfrac = 0.01 ! fraction by which to reduce the max_feasible_p if target IO PEs is not achievable. + ! (This is to provide a wiggle room for the target IO PEs to be achieved.) [nondim] + character(len=200) :: mesg ! A string to use for error messages m_to_Z = 1.0 ; if (present(US)) m_to_Z = US%m_to_Z + io_layout = [1, 1] + ! Read in params necessary for auto-masking call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & units="m", default=0.0, scale=m_to_Z, do_not_log=.true.) @@ -592,28 +620,56 @@ subroutine gen_auto_mask_table(n_global, reentrant, tripolar_N, npes, param_file endif glob_ocn_frac = real(sum(mask(1+ibuf:nx+ibuf, 1+jbuf:ny+jbuf))) / (nx * ny) + max_feasible_p = 0 + + ! Iteratively check for all possible division counts starting from the upper bound of npes/glob_ocn_frac. + ! The first encountered feasible division count is stored in max_feasible_p. If the target_io_pes is not + ! achievable with this layout, the iteration continues until max_feasible_p * (1.0 - pfrac) is reached or the + ! target_io_pes is satisfiable. If not, the target_io_pes is decremented and the iteration is re-done from + ! max_feasible_p to max_feasible_p * (1.0 - pfrac). + outer: do i = target_io_pes, 1, -1 + + if (max_feasible_p == 0) then ! first iteration + p_up = ceiling(npes/glob_ocn_frac) + else ! subsequent iterations with reduced target_io_pes + p_up = max_feasible_p + endif - ! Iteratively check for all possible division counts starting from the upper bound of npes/glob_ocn_frac, - ! which is over-optimistic for realistic domains, but may be satisfied with idealized domains. - do p = ceiling(npes/glob_ocn_frac), npes, -1 - - ! compute the layout for the current division count, p - call MOM_define_layout(n_global, p, layout) - - ! don't bother checking this p if the aspect ratio is extreme - r_p = (real(nx)/layout(1)) / (real(ny)/layout(2)) - if ( r_p * r_extreme < 1 .or. r_extreme < r_p ) cycle - - ! Get the number of masked_blocks for this particular division count - call determine_land_blocks(mask, nx, ny, layout(1), layout(2), ibuf, jbuf, num_masked_blocks) + do p = p_up, npes, -1 + + ! compute the layout for the current division count, p + call MOM_define_layout(n_global, p, layout) + + ! don't bother checking this p if the aspect ratio is extreme + ar = (real(nx)/layout(1)) / (real(ny)/layout(2)) + if ( ar * r_extreme < 1 .or. r_extreme < ar ) cycle + + ! Get the number of masked_blocks for this particular division count + call determine_land_blocks(mask, nx, ny, layout(1), layout(2), ibuf, jbuf, num_masked_blocks) + + ! If we can eliminate enough blocks to reach the target compute npes, check if the target IO PEs can also be + ! satisfied with this layout. If so, terminate the whole iteration. + if (p-num_masked_blocks <= npes) then ! We can eliminate enough blocks to reach the target compute npes + if (max_feasible_p == 0) max_feasible_p = p + if (mod(layout(1)*layout(2), i) == 0) then + io_layout = auto_determine_io_layout(layout(1), layout(2), i) + ! skip if aspect ratio is extreme + ar = (real(layout(1))/io_layout(1)) / (real(layout(2))/io_layout(2)) + if ( ar * r_extreme < 1 .or. r_extreme < ar ) cycle + call MOM_error(NOTE, "Found the optimum layout for auto-masking. Terminating iteration.") + if (i /= target_io_pes) then + write(mesg,'(a,i0)') "For compatibility with compute layout, changed number of IO PEs to: ", i + call MOM_error(NOTE, mesg) + endif + exit outer + endif + endif - ! If we can eliminate enough blocks to reach the target npes, adopt - ! this p (and the associated layout) and terminate the iteration. - if (p-num_masked_blocks <= npes) then - call MOM_error(NOTE, "Found the optimum layout for auto-masking. Terminating iteration...") - exit - endif - enddo + ! Do not reduce the division count too much to satisfy the target_io_pes. Instead, re-do the iteration + ! with a reduced target_io_pes. + if (p <= max_feasible_p * (1.0 - pfrac)) exit ! (inner do loop) + enddo + enddo outer if (num_masked_blocks == 0) then call MOM_error(FATAL, "Couldn't auto-eliminate any land blocks. Try to increase the number "//& @@ -702,4 +758,41 @@ subroutine write_auto_mask_file(mask_table, layout, npes, filename) call close_file(file_ascii) end subroutine write_auto_mask_file +!> Computes the io layout based on the domain layout and a target number of IO PEs. +function auto_determine_io_layout(idiv, jdiv, nio) result(best_io_layout) + integer, intent(in) :: idiv ! The number of compute divisions along the x-axis + integer, intent(in) :: jdiv ! The number of compute divisions along the y-axis + integer, intent(in) :: nio ! Target number of IO PEs, s.t., (idiv_io * jdiv_io) % nio == 0 + ! return + integer :: io_layout(2) ! Temporary IO layout + integer :: best_io_layout(2) ! Best IO layout + integer :: f, best_idiv_io, best_jdiv_io + real :: ratio_diff, min_ratio_diff + + if (mod(idiv*jdiv, nio) /= 0) then + call MOM_error(FATAL, "The product of the compute layout must be divisible by the target number of IO PEs.") + endif + + min_ratio_diff = 1.0e30 ! Large initial value + best_io_layout = [1, nio] + + ! Iterate over all factors of nio + do f = 1, nio + if (mod(nio, f) /= 0) cycle + io_layout = [f, nio / f] + + ! Check divisibility constraints + if (mod(idiv, io_layout(1)) == 0 .and. mod(jdiv, io_layout(2)) == 0) then + ratio_diff = abs(real(io_layout(1)) / real(io_layout(2)) - real(idiv) / real(jdiv)) + + ! Update best choice if ratio_diff is smaller + if (ratio_diff < min_ratio_diff) then + min_ratio_diff = ratio_diff + best_io_layout = [io_layout(1), io_layout(2)] + end if + end if + end do + +end function auto_determine_io_layout + end module MOM_domains diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 66d50b9ca0..a2632c7562 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -60,6 +60,7 @@ module MOM_io public :: file_exists, open_ASCII_file, close_file public :: MOM_file, MOM_infra_file, MOM_netcdf_file public :: field_exists, get_filename_appendix +public :: insert_ensemble_appendix public :: fieldtype, field_size, get_field_atts public :: axistype, get_axis_data public :: MOM_read_data, MOM_read_vector, read_field_chksum @@ -2999,6 +3000,47 @@ subroutine MOM_write_field_0d(IO_handle, field_md, field, tstamp, fill_value, sc call IO_handle%write_field(field_md, scaled_val, tstamp=tstamp) end subroutine MOM_write_field_0d +!> Insert the ensemble appendix into a filename. If provided, the appendix is inserted after +!! the last occurrence of the insert_after substring in the filename. +subroutine insert_ensemble_appendix(filename, insert_after) + character(len=*), intent(inout) :: filename !< The filename to which the appendix is inserted + character(len=*), optional, intent(in) :: insert_after !< The string after which the appendix is inserted. + !! If not provided or found, the appendix is inserted + !! at the end of the filename. + ! Local variables + character(len=32) :: filename_appendix ! ensemble appendix to be inserted into the filename + character(len=:), allocatable :: filename_tr ! trimmed filename + character(len=:), allocatable :: insert_after_tr ! trimmed insert_after + integer :: pos ! The filename string index after which the appendix is to be inserted + + call get_filename_appendix(filename_appendix) + if (len_trim(filename_appendix) == 0) return + + filename_tr = trim(adjustl(filename)) + pos = len(filename_tr) + + ! If insert_after is provided, find the last occurrence of insert_after in the filename and set pos accordingly. + if (present(insert_after)) then + insert_after_tr = trim(adjustl(insert_after)) + pos = index(filename_tr, insert_after_tr, back=.true.) + if (pos == 0) then + call MOM_error(FATAL, "insert_ensemble_appendix: The string " // insert_after_tr // & + " was not found in the filename " // filename_tr) + endif + pos = pos + len(insert_after_tr) - 1 + endif + + ! Insert the ensemble appendix into the filename. If the appendix is to be added to + ! the end of the filename, do so before the .nc extension if it exists. + if (pos>3 .and. pos == len(filename_tr)) then + if (filename_tr(pos-2:pos) == ".nc") then + pos = pos - 3 ! Position before the .nc extension + endif + endif + filename = filename_tr(1:pos) // trim(filename_appendix) // filename_tr(pos+1:) + +end subroutine insert_ensemble_appendix + !> Given filename and fieldname, this subroutine returns the size of the field in the file subroutine field_size(filename, fieldname, sizes, field_found, no_domain, ndims, ncid_in) character(len=*), intent(in) :: filename !< The name of the file to read diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index ef4adb193a..47731ab1c0 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -15,10 +15,11 @@ module MOM_restart use MOM_io, only : create_MOM_file, file_exists use MOM_io, only : MOM_infra_file, MOM_field use MOM_io, only : MOM_read_data, read_data, MOM_write_field, field_exists -use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc, get_filename_appendix +use MOM_io, only : vardesc, var_desc, query_vardesc, modify_vardesc use MOM_io, only : MULTIPLE, READONLY_FILE, SINGLE_FILE use MOM_io, only : CENTER, CORNER, NORTH_FACE, EAST_FACE use MOM_io, only : axis_info, get_axis_info +use MOM_io, only : insert_ensemble_appendix use MOM_string_functions, only : lowercase use MOM_time_manager, only : time_type, time_type_to_real, real_to_time use MOM_time_manager, only : days_in_month, get_date, set_date @@ -134,6 +135,8 @@ module MOM_restart type(p4d), pointer :: var_ptr4d(:) => NULL() !>@} integer :: max_fields !< The maximum number of restart fields + character(len=32) :: ensemble_appendix_prefix !< The prefix after which the ensemble id appendix is added + !! in output file names. end type MOM_restart_CS !> Register fields for restarts @@ -1653,15 +1656,7 @@ subroutine save_restart(directory, time, G, CS, time_stamped, filename, GV, num_ endif ; endif ! Determine if there is a filename_appendix (used for ensemble runs). - call get_filename_appendix(filename_appendix) - if (len_trim(filename_appendix) > 0) then - length = len_trim(restartname) - if (restartname(length-2:length) == '.nc') then - restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' - else - restartname = restartname(1:length) //'.'//trim(filename_appendix) - endif - endif + call insert_ensemble_appendix(restartname, CS%ensemble_appendix_prefix) next_var = 1 do while (next_var <= CS%novars ) @@ -2133,17 +2128,7 @@ function open_restart_units(filename, directory, G, CS, IO_handles, file_paths, still_looking = (num_restart <= 0) ! Avoid going through the file list twice. do while (still_looking) restartname = trim(CS%restartfile) - - ! Determine if there is a filename_appendix (used for ensemble runs). - call get_filename_appendix(filename_appendix) - if (len_trim(filename_appendix) > 0) then - length = len_trim(restartname) - if (restartname(length-2:length) == '.nc') then - restartname = restartname(1:length-3)//'.'//trim(filename_appendix)//'.nc' - else - restartname = restartname(1:length) //'.'//trim(filename_appendix) - endif - endif + call insert_ensemble_appendix(restartname, CS%ensemble_appendix_prefix) filepath = trim(directory) // trim(restartname) write(suffix,'("_",I0)') num_restart @@ -2297,6 +2282,12 @@ subroutine restart_init(param_file, CS, restart_root) "made from a run with a different mask_table than the current run, "//& "in which case the checksums will not match and cause crash.",& default=.true.) + call get_param(param_file, mdl, "ENSEMBLE_APPENDIX_PREFIX", CS%ensemble_appendix_prefix, & + "If set to a non-empty string, this value specifies the substring after which "//& + "the ensemble appendix is inserted in restart, initial conditions, and ocean "//& + "geometry file names. If the specified substring is not found in any of those "//& + "output file names, the model terminates with an error.", & + default="") call get_param(param_file, mdl, "RESTART_SYMMETRIC_CHECKSUMS", CS%symmetric_checksums, & "If true, do the restart checksums on all the edge points for a non-reentrant "//& "grid. This requires that SYMMETRIC_MEMORY_ is defined at compile time.", & diff --git a/src/framework/_Diagnostics.dox b/src/framework/_Diagnostics.dox index 0be318f580..108354723b 100644 --- a/src/framework/_Diagnostics.dox +++ b/src/framework/_Diagnostics.dox @@ -135,7 +135,7 @@ An arbitrary number of lines, one per diagnostic field: The list of available diagnostics is dependent on the particular configuration of the model. For this reason the model writes a record of the available diagnostic fields at run-time into a file "available_diags.*". -See, for example, [available_diags.000000](https://github.com/NOAA-GFDL/MOM6-examples/blob/dev/master/ocean_only/global_ALE/z/available_diags.000000) for the global_ALE z-coordinate ocean-only test case. +See, for example, [available_diags.000000](https://github.com/NOAA-GFDL/MOM6-examples/blob/dev/gfdl/ocean_only/global_ALE/z/available_diags.000000) for the global_ALE z-coordinate ocean-only test case. Diagnostic fields in the module "ocean_model" refer to the native variables or diagnostics in the native grid. Since the model can be run in arbitrary coordinates, say in hybrid-coordinate mode, then native-space diagnostics can be potentially confusing. diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 5ecee4620e..8cdf8156af 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -18,6 +18,7 @@ module MOM_shared_initialization use MOM_io, only : MOM_read_data, MOM_read_vector, read_variable, stdout use MOM_io, only : open_file_to_read, close_file_to_read, SINGLE_FILE, MULTIPLE use MOM_io, only : slasher, vardesc, MOM_write_field, var_desc +use MOM_io, only : insert_ensemble_appendix use MOM_string_functions, only : uppercase use MOM_unit_scaling, only : unit_scale_type @@ -1344,6 +1345,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) character(len=240) :: filepath ! The full path to the file to write character(len=40) :: mdl = "write_ocean_geometry_file" character(len=32) :: filename_appendix = '' ! Appendix to geom filename for ensemble runs + character(len=32) :: ensemble_appendix_prefix ! The prefix after which the ensemble id appendix is added type(vardesc), dimension(:), allocatable :: & vars ! Types with metadata about the variables and their staggering type(MOM_field), dimension(:), allocatable :: & @@ -1356,7 +1358,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) call callTree_enter('write_ocean_geometry_file()') - nFlds = 19 ; if (G%bathymetry_at_vel) nFlds = 23 + nFlds = 23 ; if (G%bathymetry_at_vel) nFlds = 27 allocate(vars(nFlds)) allocate(fields(nFlds)) @@ -1375,28 +1377,32 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) vars(2) = var_desc("geolonb","degree","longitude at corner (Bu) points",'q','1','1') vars(3) = var_desc("geolat","degree", "latitude at tracer (T) points", 'h','1','1') vars(4) = var_desc("geolon","degree","longitude at tracer (T) points",'h','1','1') - vars(5) = var_desc("D","meter","Basin Depth",'h','1','1') - vars(6) = var_desc("f","s-1","Coriolis Parameter",'q','1','1') - vars(7) = var_desc("dxCv","m","Zonal grid spacing at v points",'v','1','1') - vars(8) = var_desc("dyCu","m","Meridional grid spacing at u points",'u','1','1') - vars(9) = var_desc("dxCu","m","Zonal grid spacing at u points",'u','1','1') - vars(10)= var_desc("dyCv","m","Meridional grid spacing at v points",'v','1','1') - vars(11)= var_desc("dxT","m","Zonal grid spacing at h points",'h','1','1') - vars(12)= var_desc("dyT","m","Meridional grid spacing at h points",'h','1','1') - vars(13)= var_desc("dxBu","m","Zonal grid spacing at q points",'q','1','1') - vars(14)= var_desc("dyBu","m","Meridional grid spacing at q points",'q','1','1') - vars(15)= var_desc("Ah","m2","Area of h cells",'h','1','1') - vars(16)= var_desc("Aq","m2","Area of q cells",'q','1','1') - - vars(17)= var_desc("dxCvo","m","Open zonal grid spacing at v points",'v','1','1') - vars(18)= var_desc("dyCuo","m","Open meridional grid spacing at u points",'u','1','1') - vars(19)= var_desc("wet", "nondim", "land or ocean?", 'h','1','1') + vars(5) = var_desc("geolatu","degree","latitude at zonal velocity (Cu) points",'u','1','1') + vars(6) = var_desc("geolonu","degree","longitude at zonal velocity (Cu) points",'u','1','1') + vars(7) = var_desc("geolatv","degree","latitude at meridional velocity (Cv) points",'v','1','1') + vars(8) = var_desc("geolonv","degree","longitude at meridional velocity (Cv) points",'v','1','1') + vars(9) = var_desc("D","meter","Basin Depth",'h','1','1') + vars(10)= var_desc("f","s-1","Coriolis Parameter",'q','1','1') + vars(11)= var_desc("dxCv","m","Zonal grid spacing at v points",'v','1','1') + vars(12)= var_desc("dyCu","m","Meridional grid spacing at u points",'u','1','1') + vars(13)= var_desc("dxCu","m","Zonal grid spacing at u points",'u','1','1') + vars(14)= var_desc("dyCv","m","Meridional grid spacing at v points",'v','1','1') + vars(15)= var_desc("dxT","m","Zonal grid spacing at h points",'h','1','1') + vars(16)= var_desc("dyT","m","Meridional grid spacing at h points",'h','1','1') + vars(17)= var_desc("dxBu","m","Zonal grid spacing at q points",'q','1','1') + vars(18)= var_desc("dyBu","m","Meridional grid spacing at q points",'q','1','1') + vars(19)= var_desc("Ah","m2","Area of h cells",'h','1','1') + vars(20)= var_desc("Aq","m2","Area of q cells",'q','1','1') + + vars(21)= var_desc("dxCvo","m","Open zonal grid spacing at v points",'v','1','1') + vars(22)= var_desc("dyCuo","m","Open meridional grid spacing at u points",'u','1','1') + vars(23)= var_desc("wet", "nondim", "land or ocean?", 'h','1','1') if (G%bathymetry_at_vel) then - vars(20) = var_desc("Dblock_u","m","Blocked depth at u points",'u','1','1') - vars(21) = var_desc("Dopen_u","m","Open depth at u points",'u','1','1') - vars(22) = var_desc("Dblock_v","m","Blocked depth at v points",'v','1','1') - vars(23) = var_desc("Dopen_v","m","Open depth at v points",'v','1','1') + vars(24) = var_desc("Dblock_u","m","Blocked depth at u points",'u','1','1') + vars(25) = var_desc("Dopen_u","m","Open depth at u points",'u','1','1') + vars(26) = var_desc("Dblock_v","m","Blocked depth at v points",'v','1','1') + vars(27) = var_desc("Dopen_v","m","Open depth at v points",'v','1','1') endif if (present(geom_file)) then @@ -1405,16 +1411,13 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) filepath = trim(directory) // "ocean_geometry" endif - ! Append ensemble run number to filename if it is an ensemble run - call get_filename_appendix(filename_appendix) - if (len_trim(filename_appendix) > 0) then - geom_file_len = len_trim(filepath) - if (filepath(geom_file_len-2:geom_file_len) == ".nc") then - filepath = filepath(1:geom_file_len-3) // '.' // trim(filename_appendix) // ".nc" - else - filepath = filepath // '.' // trim(filename_appendix) - endif - endif + call get_param(param_file, mdl, "ENSEMBLE_APPENDIX_PREFIX", ensemble_appendix_prefix, & + "If set to a non-empty string, this value specifies the substring after which "//& + "the ensemble appendix is inserted in restart, initial conditions, and ocean "//& + "geometry file names. If the specified substring is not found in any of those "//& + "output file names, the model terminates with an error.", & + default="", do_not_log=.true.) + call insert_ensemble_appendix(filepath, ensemble_appendix_prefix) call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", multiple_files, & "If true, the IO layout is used to group processors that write to the same "//& @@ -1431,31 +1434,35 @@ subroutine write_ocean_geometry_file(G, param_file, directory, US, geom_file) call MOM_write_field(IO_handle, fields(2), G%Domain, G%geoLonBu) call MOM_write_field(IO_handle, fields(3), G%Domain, G%geoLatT) call MOM_write_field(IO_handle, fields(4), G%Domain, G%geoLonT) - - call MOM_write_field(IO_handle, fields(5), G%Domain, G%bathyT, unscale=US%Z_to_m) - call MOM_write_field(IO_handle, fields(6), G%Domain, G%CoriolisBu, unscale=US%s_to_T) - - call MOM_write_field(IO_handle, fields(7), G%Domain, G%dxCv, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(8), G%Domain, G%dyCu, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(9), G%Domain, G%dxCu, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(10), G%Domain, G%dyCv, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxT, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyT, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxBu, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyBu, unscale=US%L_to_m) - - call MOM_write_field(IO_handle, fields(15), G%Domain, G%areaT, unscale=US%L_to_m**2) - call MOM_write_field(IO_handle, fields(16), G%Domain, G%areaBu, unscale=US%L_to_m**2) - - call MOM_write_field(IO_handle, fields(17), G%Domain, G%dx_Cv, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(18), G%Domain, G%dy_Cu, unscale=US%L_to_m) - call MOM_write_field(IO_handle, fields(19), G%Domain, G%mask2dT) + call MOM_write_field(IO_handle, fields(5), G%Domain, G%geoLatCu) + call MOM_write_field(IO_handle, fields(6), G%Domain, G%geoLonCu) + call MOM_write_field(IO_handle, fields(7), G%Domain, G%geoLatCv) + call MOM_write_field(IO_handle, fields(8), G%Domain, G%geoLonCv) + + call MOM_write_field(IO_handle, fields(9), G%Domain, G%bathyT, unscale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(10), G%Domain, G%CoriolisBu, unscale=US%s_to_T) + + call MOM_write_field(IO_handle, fields(11), G%Domain, G%dxCv, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(12), G%Domain, G%dyCu, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(13), G%Domain, G%dxCu, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(14), G%Domain, G%dyCv, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(15), G%Domain, G%dxT, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(16), G%Domain, G%dyT, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(17), G%Domain, G%dxBu, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(18), G%Domain, G%dyBu, unscale=US%L_to_m) + + call MOM_write_field(IO_handle, fields(19), G%Domain, G%areaT, unscale=US%L_to_m**2) + call MOM_write_field(IO_handle, fields(20), G%Domain, G%areaBu, unscale=US%L_to_m**2) + + call MOM_write_field(IO_handle, fields(21), G%Domain, G%dx_Cv, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(22), G%Domain, G%dy_Cu, unscale=US%L_to_m) + call MOM_write_field(IO_handle, fields(23), G%Domain, G%mask2dT) if (G%bathymetry_at_vel) then - call MOM_write_field(IO_handle, fields(20), G%Domain, G%Dblock_u, unscale=US%Z_to_m) - call MOM_write_field(IO_handle, fields(21), G%Domain, G%Dopen_u, unscale=US%Z_to_m) - call MOM_write_field(IO_handle, fields(22), G%Domain, G%Dblock_v, unscale=US%Z_to_m) - call MOM_write_field(IO_handle, fields(23), G%Domain, G%Dopen_v, unscale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(24), G%Domain, G%Dblock_u, unscale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(25), G%Domain, G%Dopen_u, unscale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(26), G%Domain, G%Dblock_v, unscale=US%Z_to_m) + call MOM_write_field(IO_handle, fields(27), G%Domain, G%Dopen_v, unscale=US%Z_to_m) endif call IO_handle%close() diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 672de2532c..1410f37ff8 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -90,6 +90,9 @@ module MOM_hor_visc !! that gets backscattered in the Leith+E scheme. [nondim] logical :: smooth_Ah !< If true (default), then Ah and m_leithy are smoothed. !! This smoothing requires a lot of blocking communication. + logical :: taper_leithy !< If true, backscatter coeff is tapered to zero with depth + real :: leithy_depth !< If tapering leith+E, taper is applied below this depth [Z ~> m] + real :: leithy_width !< If tapering leith+E, backscatter is zero below leithy_depth+leithy_width [Z ~> m] logical :: use_QG_Leith_visc !< If true, use QG Leith nonlinear eddy viscosity. !! KH is the background value. logical :: bound_Coriolis !< If true & SMAGORINSKY_AH is used, the biharmonic @@ -181,6 +184,9 @@ module MOM_hor_visc dy2h, & !< Pre-calculated dy^2 at h points [L2 ~> m2] dx_dyT, & !< Pre-calculated dx/dy at h points [nondim] dy_dxT !< Pre-calculated dy/dx at h points [nondim] + real, allocatable :: Iwts(:,:) !< Pre-calculated 1./sum_5x5(G%mask2dT) [nondim] + real, allocatable :: Iwts_u(:,:) !< 1/sum_5x5(G%mask2Cu) [nondim] + real, allocatable :: Iwts_v(:,:) !< 1/sum_5x5(G%mask2Cv) [nondim] real, allocatable :: m_const_leithy(:,:) !< Pre-calculated .5*sqrt(c_K)*max{dx,dy} [L ~> m] real, allocatable :: m_leithy_max(:,:) !< Pre-calculated 4./max(dx,dy)^2 at h points [L-2 ~> m-2] real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEMB_PTR_) :: & @@ -472,6 +478,9 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, hrat_min, & ! h_min divided by the thickness at the stress point (h or q) [nondim] visc_bound_rem ! fraction of overall viscous bounds that remain to be applied (h or q) [nondim] + ! Layer depth. Used to taper Leith+E backscatter coefficient with depth + real, allocatable :: zc(:,:,:) ! depth at center of h cell [Z ~> m] + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -649,9 +658,24 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, ! One call applies the filter twice u_smooth(:,:,k) = u(:,:,k) v_smooth(:,:,k) = v(:,:,k) - call smooth_x9_uv(G, u_smooth(:,:,k), v_smooth(:,:,k), zero_land=.false.) + call smooth_x9_uv(CS, G, u_smooth(:,:,k), v_smooth(:,:,k), zero_land=.false.) enddo call pass_vector(u_smooth, v_smooth, G%Domain) + ! If tapering the backscatter, calculate depths now + if (CS%taper_leithy) then + ! allocate zc + allocate(zc(SZI_(G),SZJ_(G),SZK_(GV))) ; zc(:,:,:) = 0.0 + ! Convert layer thicknesses to geometric heights so zc is in [Z ~> m] + ! to match the units of CS%leithy_depth and CS%leithy_width. + call thickness_to_dz(h, tv, dz, G, GV, US, halo_size=1) + ! Compute zc. Not actual cell centers because it starts at 0 rather than at SSH. + do j=js-1,je+1 ; do i=is-1,ie+1 + zc(i,j,1) = 0.5 * dz(i,j,1) + enddo ; enddo + do k=2,nz ; do j=js-1,je+1 ; do i=is-1,ie+1 + zc(i,j,k) = zc(i,j,k-1) + 0.5 * (dz(i,j,k-1) + dz(i,j,k)) + enddo ; enddo ; enddo + endif endif if (CS%use_QG_Leith_visc .and. ((CS%Leith_Kh) .or. (CS%Leith_Ah))) then @@ -675,7 +699,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, !$OMP h_neglect, h_neglect3, inv_PI3, inv_PI6, & !$OMP diffu, diffv, Kh_h, Kh_q, Ah_h, Ah_q, FrictWork, FrictWork_bh, FrictWork_GME, & !$OMP div_xx_h, sh_xx_h, vort_xy_q, sh_xy_q, GME_coeff_h, GME_coeff_q, & - !$OMP KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah, NoSt, ShSt, hu_cont, hv_cont, STOCH & + !$OMP KH_u_GME, KH_v_GME, grid_Re_Kh, grid_Re_Ah, NoSt, ShSt, hu_cont, hv_cont, STOCH, zc & !$OMP ) & !$OMP private( & !$OMP i, j, k, n, tmp, & @@ -1237,14 +1261,6 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, enddo ; enddo endif - ! In Leith+E parameterization Kh is computed after Ah in the biharmonic loop. - ! The harmonic component of str_xx is added in the biharmonic loop. - if (CS%use_Leithy) then - do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh - Kh(i,j) = 0. - enddo ; enddo - endif - if (CS%id_Kh_h>0 .or. CS%debug) then do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh Kh_h(i,j,k) = Kh(i,j) @@ -1337,14 +1353,17 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, else m_leithy(i,j) = CS%m_leithy_max(i,j) endif - m_leithy(i,j) = G%mask2dBu(i,j) * m_leithy(i,j) + endif + if (CS%taper_leithy) then + ! Multiply m_leithy by taper function of depth + m_leithy(i,j) = m_leithy(i,j) * leithy_taper_function(CS, zc(i,j,k)) endif enddo ; enddo if (CS%smooth_Ah) then ! Smooth m_leithy. A single call smoothes twice. call pass_var(m_leithy, G%Domain, halo=2) - call smooth_x9_h(G, m_leithy, zero_land=.true.) + call smooth_x9_h(CS, G, m_leithy, zero_land=.true.) call pass_var(m_leithy, G%Domain) endif ! Get Ah @@ -1363,7 +1382,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, enddo ; enddo call pass_var(Ah_sq, G%Domain, halo=2) ! A single call smoothes twice. - call smooth_x9_h(G, Ah_sq, zero_land=.false.) + call smooth_x9_h(CS, G, Ah_sq, zero_land=.false.) call pass_var(Ah_sq, G%Domain) do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh Ah_h(i,j,k) = max(CS%Ah_bg_xx(i,j), sqrt(max(0., Ah_sq(i,j)))) @@ -1425,8 +1444,8 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, ! Compute Leith+E Kh after bounds have been applied to Ah ! and after it has been smoothed. Kh = -m_leithy * Ah do j=js_Kh,je_Kh ; do i=is_Kh,ie_Kh - Kh(i,j) = -m_leithy(i,j) * Ah(i,j) - Kh_h(i,j,k) = Kh(i,j) + Kh_BS(i,j) = -m_leithy(i,j) * Ah(i,j) + BS_coeff_h(i,j,k) = Kh_BS(i,j) enddo ; enddo endif @@ -1445,7 +1464,7 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, str_xx(i,j) = str_xx(i,j) + d_str - if (CS%use_Leithy) str_xx(i,j) = str_xx(i,j) - Kh(i,j) * sh_xx_smooth(i,j) + if (CS%use_Leithy) str_xx(i,j) = str_xx(i,j) - Kh_BS(i,j) * sh_xx_smooth(i,j) ! Keep a copy of the biharmonic contribution for backscatter parameterization bhstr_xx(i,j) = d_str * (h(i,j,k) * CS%reduction_xx(i,j)) @@ -1675,9 +1694,16 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, if (CS%use_Leithy) then ! Leith+E doesn't recompute Kh at q points, it just interpolates it from h to q points do J=js-1,Jeq ; do I=is-1,Ieq - Kh(I,J) = 0.25 * ((Kh_h(i,j,k) + Kh_h(i+1,j+1,k)) + (Kh_h(i,j+1,k) + Kh_h(i+1,j,k))) + Kh_BS(I,J) = 0.25 * ((BS_coeff_h(i,j ,k) + BS_coeff_h(i+1,j+1,k)) + & + (BS_coeff_h(i,j+1,k) + BS_coeff_h(i+1,j ,k))) enddo ; enddo - end if + endif + + if (CS%id_BS_coeff_q>0) then + do J=js-1,Jeq ; do I=is-1,Ieq + BS_coeff_q(I,J,k) = Kh_BS(I,J) + enddo ; enddo + endif if (CS%id_Kh_q > 0 .or. CS%debug) then do J=js-1,Jeq ; do I=is-1,Ieq @@ -1697,13 +1723,13 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, enddo ; enddo endif - if (.not. CS%use_Leithy) then - do J=js-1,Jeq ; do I=is-1,Ieq - str_xy(I,J) = -Kh(I,J) * sh_xy(I,J) - enddo ; enddo - else + do J=js-1,Jeq ; do I=is-1,Ieq + str_xy(I,J) = -Kh(I,J) * sh_xy(I,J) + enddo ; enddo + + if (CS%use_Leithy) then do J=js-1,Jeq ; do I=is-1,Ieq - str_xy(I,J) = -Kh(I,J) * sh_xy_smooth(I,J) + str_xy(I,J) = str_xy(I,J) - Kh_BS(I,J) * sh_xy_smooth(I,J) enddo ; enddo endif else @@ -2231,6 +2257,9 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, if (CS%id_visc_limit_q_frac>0) call post_data(CS%id_visc_limit_q_frac, visc_limit_q_frac, CS%diag) if (CS%id_visc_limit_h_flag>0) call post_data(CS%id_visc_limit_h_flag, visc_limit_h_flag, CS%diag) if (CS%id_visc_limit_q_flag>0) call post_data(CS%id_visc_limit_q_flag, visc_limit_q_flag, CS%diag) + endif + + if (CS%EY24_EBT_BS .or. CS%use_leithy) then if (CS%id_BS_coeff_h>0) call post_data(CS%id_BS_coeff_h, BS_coeff_h, CS%diag) if (CS%id_BS_coeff_q>0) call post_data(CS%id_BS_coeff_q, BS_coeff_q, CS%diag) endif @@ -2295,6 +2324,8 @@ subroutine horizontal_viscosity(u, v, h, uh, vh, diffu, diffv, MEKE, VarMix, G, CS%dx2h, CS%dy2h, CS%dx2q, CS%dy2q) endif + if (allocated(zc)) deallocate(zc) + end subroutine horizontal_viscosity !> Allocates space for and calculates static variables used by horizontal_viscosity. @@ -2543,6 +2574,10 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "If true, use a biharmonic Leith nonlinear eddy "//& "viscosity together with a harmonic backscatter.", & default=.false.) + if (CS%EY24_EBT_BS .and. CS%use_Leithy) then + call MOM_error(FATAL, "MOM_hor_visc.F90, hor_visc_init:"//& + "Cannot simultaneously use EY24 EBT backscatter and Leith+E backscatter") + endif call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited "//& "to be stable.", default=.true., do_not_log=.not.CS%biharmonic) @@ -2664,6 +2699,19 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) "If true, Ah and m_leithy are smoothed within Leith+E. This requires "//& "lots of blocking communications, which can be expensive", & default=.true., do_not_log=.not.CS%use_Leithy) + call get_param(param_file, mdl, "TAPER_LEITHY", CS%taper_leithy, & + "If true, Leith+E c_K coefficient is tapered to zero "//& + "below a threshold depth", & + default=.false., do_not_log=.not.CS%use_Leithy) + if (CS%taper_leithy) then + call get_param(param_file, mdl, "LEITHY_DEPTH", CS%leithy_depth, & + "Leith+E backscatter starts tapering below this depth.", & + units="m", scale=US%m_to_Z, default=800.0) + call get_param(param_file, mdl, "LEITHY_WIDTH", CS%leithy_width, & + "Leith+E backscatter is zero below LEITHY_DEPTH+LEITHY_WIDTH.", & + units="m", scale=US%m_to_Z, default=400.0) + if (CS%leithy_width <= 0.0) call MOM_error(FATAL,"ERROR: LEITHY_WIDTH must be positive ") + endif if (CS%use_GME .and. .not.split) call MOM_error(FATAL,"ERROR: Currently, USE_GME = True "// & "cannot be used with SPLIT=False.") @@ -2797,6 +2845,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) allocate(CS%biharm6_const_xy(IsdB:IedB,JsdB:JedB), source=0.0) endif if (CS%use_Leithy) then + allocate(CS%Iwts(isd:ied,jsd:jed), source=0.0) + allocate(CS%Iwts_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%Iwts_v(isd:ied,JsdB:JedB), source=0.0) allocate(CS%m_const_leithy(isd:ied,jsd:jed), source=0.0) allocate(CS%m_leithy_max(isd:ied,jsd:jed), source=0.0) endif @@ -2951,7 +3002,9 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) if (CS%use_Leithy) then CS%biharm6_const_xx(i,j) = Leith_bi_const * max(G%dxT(i,j),G%dyT(i,j))**6 CS%m_const_leithy(i,j) = 0.5 * sqrt(CS%c_K) * max(G%dxT(i,j),G%dyT(i,j)) - CS%m_leithy_max(i,j) = 4. / max(G%dxT(i,j),G%dyT(i,j))**2 + CS%m_leithy_max(i,j) = (4. / max(G%dxT(i,j),G%dyT(i,j))**2) * & + G%mask2dBu(i,j ) * G%mask2dBu(i-1,j ) * & + G%mask2dBu(i,j-1) * G%mask2dBu(i-1,j-1) endif CS%Ah_bg_xx(i,j) = MAX(Ah, Ah_vel_scale * grid_sp_h2 * sqrt(grid_sp_h2)) if (CS%Re_Ah > 0.0) CS%Re_Ah_const_xx(i,j) = grid_sp_h3 / CS%Re_Ah @@ -2961,6 +3014,18 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) enddo ; enddo call min_across_PEs(min_grid_sp_h4) + if (CS%use_Leithy) then + do j=js,je ; do i=is,ie; if (G%mask2dT(i,j) > 0.0) then + CS%Iwts(i,j) = 1.0 / (sum_5x5(G%mask2dT(i-2:i+2,j-2:j+2)) + 1.0E-32) + endif ; enddo ; enddo + do j=js,je ; do I=Isq,Ieq ; if (G%mask2dCu(I,j) > 0.0) then + CS%Iwts_u(I,j) = 1.0 / (sum_5x5(G%mask2dCu(I-2:I+2,j-2:j+2)) + 1.0E-32) + endif ; enddo ; enddo + do J=Jsq,Jeq ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + CS%Iwts_v(i,J) = 1.0 / (sum_5x5(G%mask2dCv(i-2:i+2,J-2:J+2)) + 1.0E-32) + endif ; enddo ; enddo + endif + do J=js-1,Jeq ; do I=is-1,Ieq grid_sp_q2 = (2.0*CS%dx2q(I,J)*CS%dy2q(I,J)) / (CS%dx2q(I,J)+CS%dy2q(I,J)) grid_sp_q3 = grid_sp_q2*sqrt(grid_sp_q2) @@ -3231,7 +3296,7 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) 'W m-2', conversion=US%RZ3_T3_to_W_m2*US%L_to_Z**2) endif - if (CS%EY24_EBT_BS) then + if (CS%EY24_EBT_BS .or. CS%use_leithy) then CS%id_BS_coeff_h = register_diag_field('ocean_model', 'BS_coeff_h', diag%axesTL, Time, & 'Backscatter coefficient at h points', units='m2 s-1', conversion=US%L_to_m**2*US%s_to_T) CS%id_BS_coeff_q = register_diag_field('ocean_model', 'BS_coeff_q', diag%axesBL, Time, & @@ -3257,6 +3322,26 @@ subroutine hor_visc_init(Time, G, GV, US, param_file, diag, CS, ADp) end subroutine hor_visc_init +!> leithy_taper_function returns 1 if zc is shallower than leithy_depth; 0 if deeper than +!! leithy_depth+leithy_width; and an interpolating cubic spline in between. +function leithy_taper_function(CS, zc) + type(hor_visc_CS), intent(in) :: CS !< Control structure for horizontal viscosity + real, intent(in) :: zc !< depth of h-cell centersi [Z ~> m] + real :: leithy_taper_function ! Taper function evaluated at zc [nondim] + + ! Local variables + real :: x ! 0 at top of transition and 1 at bottom [nondim] + + x = (zc - CS%leithy_depth) / CS%leithy_width + if (zc <= CS%leithy_depth) then + leithy_taper_function = 1.0 + elseif (zc >= CS%leithy_depth + CS%leithy_width) then + leithy_taper_function = 0.0 + else + leithy_taper_function = (x - 1.0)**2 * (1.0 + 2 * x) + endif +end function leithy_taper_function + !> hor_visc_vel_stencil returns the horizontal viscosity input velocity stencil size function hor_visc_vel_stencil(CS) result(stencil) type(hor_visc_CS), intent(in) :: CS !< Control structure for horizontal viscosity @@ -3359,12 +3444,33 @@ subroutine smooth_GME(CS, G, GME_flux_h, GME_flux_q) enddo ! s-loop end subroutine smooth_GME +!> Apply a 5x5 weighted sum. In exact arithmetic this is the same as applying a 1:2:1 smoother +!! twice in each direction. The implementation here uses fewer arithmetic operations, and is +!! rotationally symmetric. To obtain the weighted average, divide the result by 256. +function sum_5x5(x) result(sum_x) + implicit none + real, intent(in) :: x(:,:) !< 5x5 array to be summed. Assumed-shape to avoid copies. [arbitrary] + real :: sum_x !< output [same as x] + real :: sum_partial !< scalar holding a partial sum, for convenience + + sum_partial = ((x(1,1) + x(5,5)) + (x(1,5) + x(5,1))) + sum_partial = sum_partial + 6.*((x(3,1) + x(1,3)) + (x(3,5) + x(5,3))) + sum_partial = sum_partial + 36.*x(3,3) + sum_partial = sum_partial + 16.*((x(2,2) + x(4,4)) + (x(2,4) + x(4,2))) + sum_x = 4.*( ((x(1,2) + x(2,1)) + (x(1,4) + x(4,1))) + & + ((x(5,2) + x(2,5)) + (x(5,4) + x(4,5))) ) + sum_x = sum_x + 24.*((x(2,3) + x(3,2)) + (x(4,3) + x(3,4))) + sum_x = sum_x + sum_partial + +end function + !> Apply a 9-point smoothing filter twice to a field staggered at a thickness point to reduce -!! horizontal two-grid-point noise. +!! horizontal two-grid-point noise. Implemented using a single 5x5 pass rather than 3x3 twice. !! Note that this subroutine does not conserve mass, so don't use it in situations where you !! need conservation. Also note that it assumes that the input field has valid values in the !! first two halo points upon entry. -subroutine smooth_x9_h(G, field_h, zero_land) +subroutine smooth_x9_h(CS, G, field_h, zero_land) + type(hor_visc_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: field_h !< h-point field to be smoothed [arbitrary] logical, optional, intent(in) :: zero_land !< If present and false, return the average @@ -3373,42 +3479,36 @@ subroutine smooth_x9_h(G, field_h, zero_land) !! land points and include them in the averages. ! Local variables - real :: fh_prev(SZI_(G),SZJ_(G)) ! The value of the h-point field at the previous iteration [arbitrary] - real :: Iwts ! The inverse of the sum of the weights [nondim] - logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent. - integer :: i, j, s, is, ie, js, je + real :: fh_prev(SZI_(G),SZJ_(G)) ! Copy of the input value of the h-point field [arbitrary] + real :: Iwts_zl = 0.00390625 ! The inverse of the sum of the weights zeroing land, = 1/256 [nondim] + logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent. + integer :: i, j, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec zero_land_val = .true. ; if (present(zero_land)) zero_land_val = zero_land - do s=1,0,-1 - fh_prev(:,:) = field_h(:,:) - ! apply smoothing on field_h using rotationally symmetric expressions. - do j=js-s,je+s ; do i=is-s,ie+s ; if (G%mask2dT(i,j) > 0.0) then - Iwts = 0.0625 - if (.not. zero_land_val) & - Iwts = 1.0 / ( (4.0*G%mask2dT(i,j) + & - ( 2.0*((G%mask2dT(i-1,j) + G%mask2dT(i+1,j)) + & - (G%mask2dT(i,j-1) + G%mask2dT(i,j+1))) + & - ((G%mask2dT(i-1,j-1) + G%mask2dT(i+1,j+1)) + & - (G%mask2dT(i-1,j+1) + G%mask2dT(i+1,j-1))) ) ) + 1.0e-16 ) - field_h(i,j) = Iwts * ( 4.0*G%mask2dT(i,j) * fh_prev(i,j) & - + (2.0*((G%mask2dT(i-1,j) * fh_prev(i-1,j) + G%mask2dT(i+1,j) * fh_prev(i+1,j)) + & - (G%mask2dT(i,j-1) * fh_prev(i,j-1) + G%mask2dT(i,j+1) * fh_prev(i,j+1))) & - + ((G%mask2dT(i-1,j-1) * fh_prev(i-1,j-1) + G%mask2dT(i+1,j+1) * fh_prev(i+1,j+1)) + & - (G%mask2dT(i-1,j+1) * fh_prev(i-1,j+1) + G%mask2dT(i+1,j-1) * fh_prev(i-1,j-1))) )) + fh_prev(:,:) = field_h(:,:) + ! apply smoothing on field_h using rotationally symmetric expressions. + if (zero_land_val) then + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + field_h(i,j) = Iwts_zl * sum_5x5(fh_prev(i-2:i+2,j-2:j+2) * G%mask2dT(i-2:i+2,j-2:j+2)) endif ; enddo ; enddo - enddo + else + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) > 0.0) then + field_h(i,j) = CS%Iwts(i,j) * sum_5x5(fh_prev(i-2:i+2,j-2:j+2) * G%mask2dT(i-2:i+2,j-2:j+2)) + endif ; enddo ; enddo + endif end subroutine smooth_x9_h !> Apply a 9-point smoothing filter twice to a pair of velocity components to reduce -!! horizontal two-grid-point noise. +!! horizontal two-grid-point noise. Implemented using a single 5x5 pass rather than 3x3 twice. !! Note that this subroutine does not conserve angular momentum, so don't use it !! in situations where you need conservation. Also note that it assumes that the !! input fields have valid values in the first two halo points upon entry. -subroutine smooth_x9_uv(G, field_u, field_v, zero_land) +subroutine smooth_x9_uv(CS, G, field_u, field_v, zero_land) + type(hor_visc_CS), intent(in) :: CS !< Control structure type(ocean_grid_type), intent(in) :: G !< Ocean grid real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: field_u !< u-point field to be smoothed [arbitrary] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: field_v !< v-point field to be smoothed [arbitrary] @@ -3418,52 +3518,42 @@ subroutine smooth_x9_uv(G, field_u, field_v, zero_land) !! land points and include them in the averages. ! Local variables. - real :: fu_prev(SZIB_(G),SZJ_(G)) ! The value of the u-point field at the previous iteration [arbitrary] - real :: fv_prev(SZI_(G),SZJB_(G)) ! The value of the v-point field at the previous iteration [arbitrary] - real :: Iwts ! The inverse of the sum of the weights [nondim] - logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent. - integer :: i, j, s, is, ie, js, je, Isq, Ieq, Jsq, Jeq + real :: fu_prev(SZIB_(G),SZJ_(G)) ! Copy of the input value of the u-point field [arbitrary] + real :: fv_prev(SZI_(G),SZJB_(G)) ! Copy of the input value of the v-point field [arbitrary] + real :: Iwts_zl = 0.00390625 ! The inverse of the sum of the weights zeroing land, = 1/256 [nondim] + logical :: zero_land_val ! The value of the zero_land optional argument or .true. if it is absent. + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB zero_land_val = .true. ; if (present(zero_land)) zero_land_val = zero_land - do s=1,0,-1 - fu_prev(:,:) = field_u(:,:) - ! apply smoothing on field_u using the original non-rotationally symmetric expressions. - do j=js-s,je+s ; do I=Isq-s,Ieq+s ; if (G%mask2dCu(I,j) > 0.0) then - Iwts = 0.0625 - if (.not. zero_land_val) & - Iwts = 1.0 / ( (4.0*G%mask2dCu(I,j) + & - ( 2.0*((G%mask2dCu(I-1,j) + G%mask2dCu(I+1,j)) + & - (G%mask2dCu(I,j-1) + G%mask2dCu(I,j+1))) + & - ((G%mask2dCu(I-1,j-1) + G%mask2dCu(I+1,j+1)) + & - (G%mask2dCu(I-1,j+1) + G%mask2dCu(I+1,j-1))) ) ) + 1.0e-16 ) - field_u(I,j) = Iwts * ( 4.0*G%mask2dCu(I,j) * fu_prev(I,j) & - + (2.0*((G%mask2dCu(I-1,j) * fu_prev(I-1,j) + G%mask2dCu(I+1,j) * fu_prev(I+1,j)) + & - (G%mask2dCu(I,j-1) * fu_prev(I,j-1) + G%mask2dCu(I,j+1) * fu_prev(I,j+1))) & - + ((G%mask2dCu(I-1,j-1) * fu_prev(I-1,j-1) + G%mask2dCu(I+1,j+1) * fu_prev(I+1,j+1)) + & - (G%mask2dCu(I-1,j+1) * fu_prev(I-1,j+1) + G%mask2dCu(I+1,j-1) * fu_prev(I-1,j-1))) )) + fu_prev(:,:) = field_u(:,:) + ! apply smoothing on field_u using the original non-rotationally symmetric expressions. + if (zero_land_val) then + do j=js,je ; do I=Isq,Ieq ; if (G%mask2dCu(I,j) > 0.0) then + field_u(I,j) = Iwts_zl * sum_5x5(fu_prev(I-2:I+2,j-2:j+2) * G%mask2dCu(I-2:I+2,j-2:j+2)) endif ; enddo ; enddo + else + do j=js,je ; do I=Isq,Ieq ; if (G%mask2dCu(I,j) > 0.0) then + field_u(I,j) = CS%Iwts_u(I,j) * & + sum_5x5(fu_prev(I-2:I+2,j-2:j+2) * G%mask2dCu(I-2:I+2,j-2:j+2)) + endif ; enddo ; enddo + endif - fv_prev(:,:) = field_v(:,:) - ! apply smoothing on field_v using the original non-rotationally symmetric expressions. - do J=Jsq-s,Jeq+s ; do i=is-s,ie+s ; if (G%mask2dCv(i,J) > 0.0) then - Iwts = 0.0625 - if (.not. zero_land_val) & - Iwts = 1.0 / ( (4.0*G%mask2dCv(i,J) + & - ( 2.0*((G%mask2dCv(i-1,J) + G%mask2dCv(i+1,J)) + & - (G%mask2dCv(i,J-1) + G%mask2dCv(i,J+1))) + & - ((G%mask2dCv(i-1,J-1) + G%mask2dCv(i+1,J+1)) + & - (G%mask2dCv(i-1,J+1) + G%mask2dCv(i+1,J-1))) ) ) + 1.0e-16 ) - field_v(i,J) = Iwts * ( 4.0*G%mask2dCv(i,J) * fv_prev(i,J) & - + (2.0*((G%mask2dCv(i-1,J) * fv_prev(i-1,J) + G%mask2dCv(i+1,J) * fv_prev(i+1,J)) + & - (G%mask2dCv(i,J-1) * fv_prev(i,J-1) + G%mask2dCv(i,J+1) * fv_prev(i,J+1))) & - + ((G%mask2dCv(i-1,J-1) * fv_prev(i-1,J-1) + G%mask2dCv(i+1,J+1) * fv_prev(i+1,J+1)) + & - (G%mask2dCv(i-1,J+1) * fv_prev(i-1,J+1) + G%mask2dCv(i+1,J-1) * fv_prev(i-1,J-1))) )) + fv_prev(:,:) = field_v(:,:) + ! apply smoothing on field_v using the original non-rotationally symmetric expressions. + if (zero_land_val) then + do J=Jsq,Jeq ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + field_v(i,J) = Iwts_zl * sum_5x5(fv_prev(i-2:i+2,J-2:J+2) * G%mask2dCv(i-2:i+2,J-2:J+2)) endif ; enddo ; enddo - enddo + else + do J=Jsq,Jeq ; do i=is,ie ; if (G%mask2dCv(i,J) > 0.0) then + field_v(i,J) = CS%Iwts_v(i,J) * & + sum_5x5(fv_prev(i-2:i+2,J-2:J+2) * G%mask2dCv(i-2:i+2,J-2:J+2)) + endif ; enddo ; enddo + endif end subroutine smooth_x9_uv @@ -3503,6 +3593,9 @@ subroutine hor_visc_end(CS) if (allocated(CS%Biharm_const2_xy)) deallocate(CS%Biharm_const2_xy) if (allocated(CS%Biharm6_const_xx)) deallocate(CS%Biharm6_const_xx) if (allocated(CS%Biharm6_const_xy)) deallocate(CS%Biharm6_const_xy) + if (allocated(CS%Iwts)) deallocate(CS%Iwts) + if (allocated(CS%Iwts_u)) deallocate(CS%Iwts_u) + if (allocated(CS%Iwts_v)) deallocate(CS%Iwts_v) if (allocated(CS%m_const_leithy)) deallocate(CS%m_const_leithy) if (allocated(CS%m_leithy_max)) deallocate(CS%m_leithy_max) if (allocated(CS%Re_Ah_const_xx)) deallocate(CS%Re_Ah_const_xx) diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 2aa7f041d4..f220d696c8 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1556,6 +1556,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) logical :: mixing_coefs_OBC_bug ! If false, use only interior data for thickness weighting in ! lateral mixing coefficient calculations and to calculate stratification ! and other fields at open boundary condition faces. + logical :: stoch_eos ! Can't use Stanley param here unless stoch_eos is true ! This include declares and sets the variable "version". # include "version_variable.h" character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. @@ -1677,15 +1678,13 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "STOCH_EOS", stoch_eos, & + default=.false., do_not_log=.true.) call get_param(param_file, mdl, "USE_STANLEY_ISO", CS%use_stanley_iso, & "If true, turn on Stanley SGS T variance parameterization "// & "in isopycnal slope code.", default=.false.) - if (CS%use_stanley_iso) then - call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & - "Coefficient correlating the temperature gradient and SGS T variance.", & - units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) call MOM_error(FATAL, & - "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ISO is true.") + if (CS%use_Stanley_ISO .and. .not.stoch_eos) then + call MOM_error(FATAL, "VarMix_init: USE_STANLEY_ISO requires STOCH_EOS") endif call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", number_of_OBC_segments, & default=0, do_not_log=.true.) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 6e558bc0c7..9aea1d5e93 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -104,8 +104,12 @@ module MOM_mixed_layer_restrat !! front-length scales read from a file. type(time_type), pointer :: Time => NULL() !< A pointer to the ocean model's clock. logical :: use_Stanley_ML !< If true, use the Stanley parameterization of SGS T variance + logical :: wave_enhanced_ustar !< If true, enhance ustar using surface waves, following Eq. 28 in Bodner23. + !! Use a Langmuir number if provided. Otherwise, assumes equilibrium + !! surface waves (La-2=11.). real :: ustar_min !< A minimum value of ustar in thickness units to avoid numerical !! problems [H T-1 ~> m s-1 or kg m-2 s-1] + 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] @@ -148,7 +152,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, h_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, Lam2) 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 @@ -169,17 +173,29 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, forces, dt, MLD, h_MLD, bflux, !! 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 + real, dimension(:,:), optional, pointer :: Lam2 !< (Langmuir Number)^-2 [nondim] + + ! local variables + logical :: haveLam2 !< True if optional Lam2 argument is both present and associated if (.not. CS%initialized) call MOM_error(FATAL, "mixedlayer_restrat: "// & "Module must be initialized before it is used.") + ! Determine if Lam2 should be used + haveLam2 = .false. + if (present(Lam2)) haveLam2 = associated(Lam2) + if (GV%nkml>0) then ! Original form, written for the isopycnal model with a bulk mixed layer 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, h_MLD, bflux) + if (haveLam2) then + call mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, MLD, h_MLD, bflux, Lam2) + else + call mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, MLD, h_MLD, bflux) + endif else ! Implementation of Fox-Kemper et al., 2008, to work in general coordinates call mixedlayer_restrat_OM4(h, uhtr, vhtr, tv, forces, dt, h_MLD, VarMix, G, GV, US, CS) @@ -754,7 +770,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, h_MLD, bflux) +subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, dt, BLD, h_MLD, bflux, Lam2) ! Arguments type(mixedlayer_restrat_CS), intent(inout) :: CS !< Module control structure type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure @@ -775,6 +791,9 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d !! 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] + real, dimension(:,:), optional, pointer :: Lam2 !< (Langmuir Number)^-2, which is defined as + !! Surface Stokes/ustar [nondim] + ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(GV)) ! zonal mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] real :: vhml(SZI_(G),SZJB_(G),SZK_(GV)) ! merid mixed layer transport [H L2 T-1 ~> m3 s-1 or kg s-1] @@ -807,6 +826,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d real :: h_vel ! htot interpolated onto velocity points [H ~> m or kg m-2] real :: w_star3 ! Cube of turbulent convective velocity [Z3 T-3 ~> m3 s-3] real :: u_star3 ! Cube of surface friction velocity [Z3 T-3 ~> m3 s-3] + real :: E_ustar ! Surface wave ustar enhancement factor [nondim] real :: r_wpup ! reciprocal of vertical momentum flux [T2 L-1 H-1 ~> s2 m-2 or m s2 kg-1] real :: absf ! absolute value of f, interpolated to velocity points [T-1 ~> s-1] real :: f_h ! Coriolis parameter at h-points [T-1 ~> s-1] @@ -830,10 +850,12 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d ! fractional power [T3 m3 Z-3 s-3 ~> 1] real :: m2_s2_to_Z2_T2 ! Conversion factors to restore scaling after a term is raised to a ! fractional power [Z2 s2 T-2 m-2 ~> 1] + real, parameter :: Lam2_eq = 11. ! (Langmuir Number)^-2 assuming wind wave equilibrium [nondim] real, parameter :: two_thirds = 2./3. ! [nondim] logical :: line_is_empty, keep_going integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz + logical :: Lam2_available is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -845,7 +867,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d covTS(:) = 0.0 ! Might be in tv% in the future. Not implemented for the time being. varS(:) = 0.0 ! Ditto. - ! This value is roughly (pi / (the age of the universe) )^2. + ! This value is roughly (pi / (the age of the universe) )^2. absurdly_small_freq2 = 1e-34*US%T_to_s**2 if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "mixedlayer_restrat_Bodner: "// & @@ -860,6 +882,9 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d "To use the Bodner et al., 2023, MLE parameterization, either MLE_USE_PBL_MLD or "// & "Bodner_detect_MLD must be True.") endif + if (CS%use_Stanley_ML .and. .not.GV%Boussinesq) call MOM_error(FATAL, & + "MOM_mixedlayer_restrat: The Stanley parameterization is not"//& + "available without the Boussinesq approximation.") if (associated(bflux)) & call pass_var(bflux, G%domain, halo=1) @@ -867,6 +892,26 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d ! Extract the friction velocity from the forcing type. call find_ustar(forces, tv, U_star_2d, G, GV, US, halo=1) + Lam2_available = present(Lam2) + if (Lam2_available) Lam2_available = associated(Lam2) + + ! Wave Enhanced of ustar following Eq. 28 in Bodner23 + if (CS%wave_enhanced_ustar) then + if (Lam2_available) then + call pass_var(Lam2, G%domain, halo=1) + do j=js-1,je+1 ; do i=is-1,ie+1 + E_ustar = sqrt( 1.0 + (Lam2(i,j) * 0.104) + (Lam2(i,j) * Lam2(i,j) * 0.00118)) + U_star_2d(i,j) = E_ustar * U_star_2d(i,j) + enddo ; enddo + else + ! Assuming wind wave equilibrium (Lam2=11) + E_ustar = sqrt( 1.0 + (Lam2_eq * 0.104) + (Lam2_eq * Lam2_eq * 0.00118)) + do j=js-1,je+1 ; do i=is-1,ie+1 + U_star_2d(i,j) = E_ustar * U_star_2d(i,j) + enddo ; enddo + endif + endif + if (CS%debug) then call hchksum(h,'mixed_Bodner: h', G%HI, haloshift=1, unscale=GV%H_to_mks) call hchksum(BLD, 'mle_Bodner: BLD', G%HI, haloshift=1, unscale=US%Z_to_m) @@ -999,7 +1044,7 @@ subroutine mixedlayer_restrat_Bodner(CS, G, GV, US, h, uhtr, vhtr, tv, forces, d !$OMP default(shared) & !$OMP private(i, j, k, keep_going, line_is_empty, dh, & !$OMP grid_dsd, absf, h_sml, h_big, grd_b, r_wpup, psi_mag, IhTot, & - !$OMP sigint, muzb, muza, hAtVel, Rml_int, SpV_int) + !$OMP sigint, muzb, muza, hAtVel, Rml_int, SpV_int, rho_ml, SpV_ml, dmu ) !$OMP do do j=js-1,je+1 @@ -1630,8 +1675,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, real :: flux_to_kg_per_s ! A unit conversion factor for fluxes. [kg T s-1 H-1 L-2 ~> kg m-3 or 1] real :: omega ! The Earth's rotation rate [T-1 ~> s-1]. real :: ustar_min_dflt ! The default value for RESTRAT_USTAR_MIN [Z T-1 ~> m s-1] - real :: Stanley_coeff ! Coefficient relating the temperature gradient and sub-gridscale - ! temperature variance [nondim] integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags ! This include declares and sets the variable "version". character(len=200) :: inputdir ! The directory where NetCDF input files @@ -1639,6 +1682,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, character(len=128) :: mle_fl_file ! Data containing MLE front-length scale. Used ! when reading from file. character(len=32) :: fl_varname ! Name of front-length scale variable in mle_fl_file. + logical :: stoch_eos ! Can't use Stanley param here unless stoch_eos is true # include "version_variable.h" integer :: i, j @@ -1675,6 +1719,14 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "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 get_param(param_file, mdl, "STOCH_EOS", stoch_eos, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_Stanley_ML, & + "If true, turn on Stanley SGS T variance parameterization "// & + "in ML restrat code.", default=.false.) + if (CS%use_Stanley_ML .and. .not.stoch_eos) then + call MOM_error(FATAL, "mixedlayer_restrat_init: USE_STANLEY_ML requires STOCH_EOS") + endif 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, & @@ -1730,15 +1782,18 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The default is less than the molecular viscosity of water times the Coriolis "//& "parameter a micron away from the equator.", & units="m2 s-2", default=1.0e-24, scale=US%m_to_Z**2*US%T_to_s**2) + call get_param(param_file, mdl, "WAVE_ENHANCED_USTAR", CS%wave_enhanced_ustar, & + "If true, enhance ustar using surface waves, following Eq. 28 in Bodner23. " //& + "Use a Langmuir number if provided. Otherwise, assumes equilibrium "// & + "surface waves (La-2=11.).", default=.false.) call get_param(param_file, mdl, "TAIL_DH", CS%MLE_tail_dh, & "Fraction by which to extend the mixed-layer restratification "//& "depth used for a smoother stream function at the base of "//& "the mixed-layer.", units="nondim", default=0.0) - call get_param(param_file, mdl, "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.) + "If true, read in a spatially varying Cr field." //& + "If CR = 0 (default), this field is scaled by 1.0." //& + "If CR>0., this field works as a mask and is scaled by CR.", 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 @@ -1762,7 +1817,13 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "The variable name for Cr field.", & default="Cr") filename = trim(inputdir) // "/" // trim(filename) - call MOM_read_data(filename, varname, CS%Cr_space, G%domain) + if (CS%Cr > 0.0) then + ! here, the file is working as a mask + call MOM_read_data(filename, varname, CS%Cr_space, G%domain, scale=CS%Cr) + else + ! read actual Cr + call MOM_read_data(filename, varname, CS%Cr_space, G%domain, scale=1.0) + endif call pass_var(CS%Cr_space, G%domain) endif call closeParameterBlock(param_file) ! The remaining parameters do not have MLE% prepended @@ -1794,17 +1855,6 @@ logical function mixedlayer_restrat_init(Time, G, GV, US, param_file, diag, CS, "geostrophic kinetic energy or 1 plus the square of the "//& "grid spacing over the deformation radius, as detailed "//& "by Fox-Kemper et al. (2011)", units="nondim", default=0.0) - ! These parameters are only used in the OM4-era version of Fox-Kemper - call get_param(param_file, mdl, "USE_STANLEY_ML", CS%use_Stanley_ML, & - "If true, turn on Stanley SGS T variance parameterization "// & - "in ML restrat code.", default=.false.) - if (CS%use_Stanley_ML) then - call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & - "Coefficient correlating the temperature gradient and SGS T variance.", & - units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) call MOM_error(FATAL, & - "STANLEY_COEFF must be set >= 0 if USE_STANLEY_ML is true.") - endif call get_param(param_file, mdl, 'VON_KARMAN_CONST', CS%vonKar, & 'The value the von Karman constant as used for mixed layer viscosity.', & units='nondim', default=0.41) diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index fc61bd0788..1c7fe38155 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -99,9 +99,6 @@ module MOM_thickness_diffuse !! When this is true, it breaks rotational symmetry. logical :: use_GM_work_bug !< If true, use the incorrect sign for the !! top-level work tendency on the top layer. - real :: Stanley_det_coeff !< The coefficient correlating SGS temperature variance with the mean - !! temperature gradient in the deterministic part of the Stanley parameterization. - !! Negative values disable the scheme. [nondim] logical :: read_khth !< If true, read a file containing the spatially varying horizontal !! isopycnal height diffusivity logical :: use_stanley_gm !< If true, also use the Stanley parameterization in MOM_thickness_diffuse @@ -2197,6 +2194,7 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) ! available. logical :: use_meke = .false. ! If true, use the MEKE formulation for the thickness diffusivity. integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. + logical :: stoch_eos ! Can't use Stanley param here unless stoch_eos is true integer :: i, j CS%initialized = .true. @@ -2324,15 +2322,13 @@ subroutine thickness_diffuse_init(Time, G, GV, US, param_file, diag, CDp, CS) "streamfunction formulation, expressed as a fraction of planetary "//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", scale=US%Z_to_L, do_not_log=.not.CS%use_FGNV_streamfn) + call get_param(param_file, mdl, "STOCH_EOS", stoch_eos, & + default=.false., do_not_log=.true.) call get_param(param_file, mdl, "USE_STANLEY_GM", CS%use_stanley_gm, & "If true, turn on Stanley SGS T variance parameterization "// & "in GM code.", default=.false.) - if (CS%use_stanley_gm) then - call get_param(param_file, mdl, "STANLEY_COEFF", Stanley_coeff, & - "Coefficient correlating the temperature gradient and SGS T variance.", & - units="nondim", default=-1.0, do_not_log=.true.) - if (Stanley_coeff < 0.0) call MOM_error(FATAL, & - "STANLEY_COEFF must be set >= 0 if USE_STANLEY_GM is true.") + if (CS%use_Stanley_GM .and. .not.stoch_eos) then + call MOM_error(FATAL, "thickness_diffuse_init: USE_STANLEY_GM requires STOCH_EOS") endif call get_param(param_file, mdl, "OMEGA", omega, & "The rotation rate of the earth.", & diff --git a/src/parameterizations/stochastic/MOM_stochastics.F90 b/src/parameterizations/stochastic/MOM_stochastics.F90 index 8e56ec3ef2..0f6e896c26 100644 --- a/src/parameterizations/stochastic/MOM_stochastics.F90 +++ b/src/parameterizations/stochastic/MOM_stochastics.F90 @@ -10,22 +10,23 @@ module MOM_stochastics ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! +use MOM_coms, only : Get_PElist use MOM_debugging, only : hchksum, uvchksum, qchksum use MOM_diag_mediator, only : register_diag_field, diag_ctrl, time_type, post_data use MOM_diag_mediator, only : register_static_field, enable_averages, disable_averaging -use MOM_grid, only : ocean_grid_type -use MOM_variables, only : thermo_var_ptrs use MOM_domains, only : pass_var, pass_vector, CORNER, SCALAR_PAIR -use MOM_verticalGrid, only : verticalGrid_type +use MOM_domains, only : root_PE, num_PEs use MOM_error_handler, only : MOM_error, MOM_mesg, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use MOM_domains, only : root_PE, num_PEs -use MOM_coms, only : Get_PElist +use MOM_grid, only : ocean_grid_type +use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs +use MOM_verticalGrid, only : verticalGrid_type use MOM_EOS, only : calculate_density, EOS_domain use stochastic_physics, only : init_stochastic_physics_ocn, run_stochastic_physics_ocn +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain #include @@ -57,12 +58,18 @@ module MOM_stochastics !! dissipation rate used to set the amplitude of SKEBS [nondim] real, allocatable :: skeb_diss(:,:,:) !< Dissipation rate used to set amplitude of SKEBS [L2 T-3 ~> m2 s-2] !! Index into this at h points. + integer :: answer_date !< The vintage of the order of arithmetic in the stochastics + !! calculations. Values below 20250701 recover the answers from + !! early in 2025, while higher values use expressions that have been + !! refactored for rotational symmetry, including with FMAs enabled. + ! stochastic patterns real, allocatable :: sppt_wts(:,:) !< Random pattern for ocean SPPT - !! tendencies with a number between 0 and 2 - real, allocatable :: skeb_wts(:,:) !< Random pattern for ocean SKEB - real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation - real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation + !! tendencies with a number between 0 and 2 [nondim] + real, allocatable :: skeb_wts(:,:) !< Random pattern of lengthscales for ocean SKEB in mks units [m] + !! Note that SKEB_wts is set via external code in mks units. + real, allocatable :: epbl1_wts(:,:) !< Random pattern for K.E. generation [nondim] + real, allocatable :: epbl2_wts(:,:) !< Random pattern for K.E. dissipation [nondim] type(time_type), pointer :: Time !< Pointer to model time (needed for sponges) type(diag_ctrl), pointer :: diag=>NULL() !< A structure that is used to regulate the @@ -72,15 +79,20 @@ module MOM_stochastics real, allocatable :: taperCv(:,:) !< Taper applied to v component of stochastic !! velocity increment range [0,1], [nondim] + ! Weights for smoothing skeb_diss + real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: Isum_area_wts, & !< One over the 3x3 sum of area_wt [L-2 ~> m-2] + area_wt !< Masked h cell areas. [L2 ~> m2] + end type stochastic_CS contains -!! This subroutine initializes the stochastics physics control structure. -subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) +!> This subroutine initializes the stochastics physics control structure. +subroutine stochastics_init(dt, grid, GV, US, CS, param_file, diag, Time) real, intent(in) :: dt !< time step [T ~> s] type(ocean_grid_type), intent(in) :: grid !< horizontal grid information type(verticalGrid_type), intent(in) :: GV !< vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(stochastic_CS), pointer, intent(inout) :: CS !< stochastic control structure type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(inout) :: diag !< structure to regulate diagnostic output @@ -94,10 +106,13 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) integer :: pe_zero ! root pe integer :: nxT, nxB ! number of x-points including halo integer :: nyT, nyB ! number of y-points including halo + integer :: default_answer_date ! The default setting for the various ANSWER_DATE flags. integer :: i, j, k ! loop indices - real :: tmp(grid%isdB:grid%iedB,grid%jsdB:grid%jedB) ! Used to construct tapers + real :: tmp(grid%isdB:grid%iedB,grid%jsdB:grid%jedB) ! Used to construct tapers [nondim] integer :: taper_width ! Width (in cells) of the taper that brings the stochastic velocity ! increments to 0 at the boundary. + real :: sum_area_wts ! A rotationally symmetric sum of the surrounding area weights + ! that are used to filter skeb_diss [L2 ~> m2] ! This include declares and sets the variable "version". # include "version_variable.h" @@ -153,6 +168,14 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) "production and dissipation terms. Amplitude and correlations are "//& "controlled by the nam_stoch namelist in the UFS model only.", & default=.false.) + call get_param(param_file, mdl, "DEFAULT_ANSWER_DATE", default_answer_date, & + "This sets the default value for the various _ANSWER_DATE parameters.", & + default=99991231, do_not_log=.true.) + call get_param(param_file, mdl, "STOCHASTICS_ANSWER_DATE", CS%answer_date, & + "The vintage of the order of arithmetic in the stochastics calculations. "//& + "Values below 20250701 recover the answers from early in 2025, while higher "//& + "values use expressions that have been refactored for rotational symmetry.", & + default=20250101) !### Change to: default=default_answer_date) if (CS%do_sppt .OR. CS%pert_epbl .OR. CS%do_skeb) then num_procs = num_PEs() @@ -163,7 +186,7 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) nyT = grid%jed - grid%jsd + 1 nxB = grid%iedB - grid%isdB + 1 nyB = grid%jedB - grid%jsdB + 1 - call init_stochastic_physics_ocn(dt, grid%geoLonT, grid%geoLatT, nxT, nyT, GV%ke, & + call init_stochastic_physics_ocn(dt*US%T_to_s, grid%geoLonT, grid%geoLatT, nxT, nyT, GV%ke, & grid%geoLonBu, grid%geoLatBu, nxB, nyB, & CS%pert_epbl, CS%do_sppt, CS%do_skeb, pe_zero, mom_comm, iret) if (iret/=0) then @@ -171,10 +194,10 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) return endif - if (CS%do_sppt) allocate(CS%sppt_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) + if ((CS%do_sppt) .or. (CS%do_skeb)) allocate(CS%sppt_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) if (CS%do_skeb) allocate(CS%skeb_wts(grid%isdB:grid%iedB,grid%jsdB:grid%jedB)) if (CS%do_skeb) allocate(CS%skeb_diss(grid%isd:grid%ied,grid%jsd:grid%jed,GV%ke), source=0.) - if (CS%pert_epbl) then + if ((CS%pert_epbl) .or. (CS%do_skeb)) then allocate(CS%epbl1_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) allocate(CS%epbl2_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) endif @@ -183,23 +206,23 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) CS%id_sppt_wts = register_diag_field('ocean_model', 'sppt_pattern', CS%diag%axesT1, Time, & 'random pattern for sppt', 'None') CS%id_skeb_wts = register_diag_field('ocean_model', 'skeb_pattern', CS%diag%axesB1, Time, & - 'random pattern for skeb', 'None') + 'random pattern for skeb', 'm', conversion=1.0) ! SKEB_wts is set in external code in mks units of [m] CS%id_epbl1_wts = register_diag_field('ocean_model', 'epbl1_wts', CS%diag%axesT1, Time, & 'random pattern for KE generation', 'None') CS%id_epbl2_wts = register_diag_field('ocean_model', 'epbl2_wts', CS%diag%axesT1, Time, & 'random pattern for KE dissipation', 'None') CS%id_skebu = register_diag_field('ocean_model', 'skebu', CS%diag%axesCuL, Time, & - 'zonal current perts', 'None') + 'zonal current perts', 'm s-1', conversion=US%L_T_to_m_s) CS%id_skebv = register_diag_field('ocean_model', 'skebv', CS%diag%axesCvL, Time, & - 'zonal current perts', 'None') + 'zonal current perts', 'm s-1', conversion=US%L_T_to_m_s) CS%id_diss = register_diag_field('ocean_model', 'skeb_amp', CS%diag%axesTL, Time, & - 'SKEB amplitude', 'm s-1') + 'SKEB amplitude', 'm s-1', conversion=US%L_T_to_m_s) CS%id_psi = register_diag_field('ocean_model', 'psi', CS%diag%axesBL, Time, & - 'stream function', 'None') + 'stream function', 'm2 s-1', conversion=US%L_T_to_m_s*US%L_to_m) CS%id_skeb_taperu = register_static_field('ocean_model', 'skeb_taper_u', CS%diag%axesCu1, & - 'SKEB taper u', 'None', interp_method='none') + 'SKEB taper u', 'None', conversion=1.0, interp_method='none') CS%id_skeb_taperv = register_static_field('ocean_model', 'skeb_taper_v', CS%diag%axesCv1, & - 'SKEB taper v', 'None', interp_method='none') + 'SKEB taper v', 'None', conversion=1.0, interp_method='none') ! Initialize the "taper" fields. These fields multiply the components of the stochastic ! velocity increment in such a way as to smoothly taper them to zero at land boundaries. @@ -242,6 +265,21 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) if (CS%id_skeb_taperu > 0) call post_data(CS%id_skeb_taperu, CS%taperCu, CS%diag, .true.) if (CS%id_skeb_taperv > 0) call post_data(CS%id_skeb_taperv, CS%taperCv, CS%diag, .true.) + ! Initialize the smoothing weights + if ((CS%do_skeb) .and. CS%skeb_npass >= 1) then + ALLOC_(CS%area_wt(grid%isd:grid%ied,grid%jsd:grid%jed)) ; CS%area_wt(:,:) = 0.0 + ALLOC_(CS%Isum_area_wts(grid%isd:grid%ied,grid%jsd:grid%jed)) ; CS%Isum_area_wts(:,:) = 0.0 + do j=grid%jsc-2,grid%jec+2 ; do i=grid%isc-2,grid%iec+2 + CS%area_wt(i,j) = grid%mask2dT(i,j)*grid%areaT(i,j) + enddo ; enddo + do j=grid%jsc-1,grid%jec+1 ; do i=grid%isc-1,grid%iec+1 + sum_area_wts = CS%area_wt(i,j) + & + (((CS%area_wt(i-1,j) + CS%area_wt(i+1,j)) + (CS%area_wt(i,j-1) + CS%area_wt(i,j+1))) + & + ((CS%area_wt(i-1,j-1) + CS%area_wt(i+1,j+1)) + (CS%area_wt(i-1,j+1) + CS%area_wt(i+1,j-1)))) + CS%Isum_area_wts(i,j) = 1.0 / (sum_area_wts + 1.e-16*US%m_to_L**2) + enddo ; enddo + endif + if (CS%do_sppt .OR. CS%pert_epbl .OR. CS%do_skeb) & call MOM_mesg(' === COMPLETED MOM STOCHASTIC INITIALIZATION =====') @@ -249,47 +287,49 @@ subroutine stochastics_init(dt, grid, GV, CS, param_file, diag, Time) end subroutine stochastics_init -!> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the -!! ocean model's state from the input value of Ocean_state (which must be for -!! time time_start_update) for a time interval of Ocean_coupling_time_step, -!! returning the publicly visible ocean surface properties in Ocean_sfc and -!! storing the new ocean properties in Ocean_state. +!> Advances the stochastic patterns one time step subroutine update_stochastics(CS) type(stochastic_CS), intent(inout) :: CS !< diabatic control structure call callTree_enter("update_stochastics(), MOM_stochastics.F90") ! update stochastic physics patterns before running next time-step - call run_stochastic_physics_ocn(CS%sppt_wts,CS%skeb_wts,CS%epbl1_wts,CS%epbl2_wts) + call run_stochastic_physics_ocn(CS%sppt_wts, CS%skeb_wts, CS%epbl1_wts, CS%epbl2_wts) call callTree_leave("update_stochastics(), MOM_stochastics.F90") end subroutine update_stochastics -subroutine apply_skeb(grid,GV,CS,uc,vc,thickness,tv,dt,Time_end) +!> Adds a stochastic increment (backscatter) to the input velocity field +subroutine apply_skeb(grid, GV, US, CS, uc, vc, thickness, tv, dt, Time_end) type(ocean_grid_type), intent(in) :: grid !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(stochastic_CS), intent(inout) :: CS !< stochastic control structure - real, dimension(SZIB_(grid),SZJ_(grid),SZK_(GV)), intent(inout) :: uc !< zonal velocity [L T-1 ~> m s-1] real, dimension(SZI_(grid),SZJB_(grid),SZK_(GV)), intent(inout) :: vc !< meridional velocity [L T-1 ~> m s-1] real, dimension(SZI_(grid),SZJ_(grid),SZK_(GV)), intent(in) :: thickness !< thickness [H ~> m or kg m-2] type(thermo_var_ptrs), intent(in) :: tv !< points to thermodynamic fields real, intent(in) :: dt !< time increment [T ~> s] type(time_type), intent(in) :: Time_end !< Time at the end of the interval -! locals - - real, dimension(SZIB_(grid),SZJB_(grid),SZK_(GV)) :: psi !< Streamfunction for stochastic velocity increments - !! [L2 T-1 ~> m2 s-1] - real, dimension(SZIB_(grid),SZJ_(grid) ,SZK_(GV)) :: ustar !< Stochastic u velocity increment [L T-1 ~> m s-1] - real, dimension(SZI_(grid) ,SZJB_(grid),SZK_(GV)) :: vstar !< Stochastic v velocity increment [L T-1 ~> m s-1] - real, dimension(SZI_(grid),SZJ_(grid)) :: diss_tmp !< Temporary array used in smoothing skeb_diss - !! [L2 T-3 ~> m2 s-2] - real, dimension(3,3) :: local_weights !< 3x3 stencil weights used in smoothing skeb_diss - !! [L2 ~> m2] - - real :: shr,ten,tot,kh - integer :: i,j,k,iter + + ! local variables + real, dimension(SZIB_(grid),SZJB_(grid),SZK_(GV)) :: psi !< Streamfunction for stochastic velocity increments + !! [L2 T-1 ~> m2 s-1] + real, dimension(SZIB_(grid),SZJ_(grid) ,SZK_(GV)) :: ustar !< Stochastic u velocity increment [L T-1 ~> m s-1] + real, dimension(SZI_(grid) ,SZJB_(grid),SZK_(GV)) :: vstar !< Stochastic v velocity increment [L T-1 ~> m s-1] + real, dimension(SZI_(grid),SZJ_(grid)) :: diss_tmp !< Temporary array used in smoothing skeb_diss + !! [L2 T-3 ~> m2 s-2] + real, dimension(3,3) :: local_weights !< 3x3 stencil weights used in smoothing skeb_diss + !! [L2 ~> m2] + + real :: shr ! Horizonal shear [T-1 ~> s-1] + real :: ten ! Horizonal tension of the flow [T-1 ~> s-1] + real :: tot ! The magnitude of the combined shear and tension [T-1 ~> s-1] + real :: kh ! A smooothing factor [nondim] + real :: sum_wtd_skeb_diss ! The rotationally symmetric sum of the surrounding values of skeb times + ! the area weights used to filter skeb_diss [L4 T-3 ~> m4 s-3] + integer :: i, j, k, iter integer, dimension(2) :: EOSdom ! The i-computational domain for the equation of state call callTree_enter("apply_skeb(), MOM_stochastics.F90") @@ -302,53 +342,81 @@ subroutine apply_skeb(grid,GV,CS,uc,vc,thickness,tv,dt,Time_end) enddo ; enddo enddo - !kh needs to be scaled - - kh=1!(120*111)**2 - do k=1,GV%ke - do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec - ! Shear - shr = (vc(i,J,k)-vc(i-1,J,k))*grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdxCv(i,J)+& - (uc(I,j,k)-uc(I,j-1,k))*grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdyCu(I,j) - ! Tension - ten = (vc(i,J,k)-vc(i-1,J,k))*grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdyCv(i,J)+& - (uc(I,j,k)-uc(I,j-1,k))*grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdxCu(I,j) - - tot = sqrt( shr**2 + ten**2 ) * grid%mask2dT(i,j) - CS%skeb_diss(i,j,k) = tot**3 * kh * grid%areaT(i,j)!!**2 - enddo ; enddo - enddo - endif ! Sets CS%skeb_diss without GM or FrictWork + ! kh needs to be scaled + kh = 1.0 !(120*111)**2 + if (CS%answer_date < 20250701) then + do k=1,GV%ke + do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec + ! Shear in [T-1 ~> s-1] + shr = (vc(i,J,k)-vc(i-1,J,k)) * grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdxCv(i,J) + & + (uc(I,j,k)-uc(I,j-1,k)) * grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdyCu(I,j) + ! Tension in [T-1 ~> s-1] + ten = (vc(i,J,k)-vc(i-1,J,k)) * grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdyCv(i,J) + & + (uc(I,j,k)-uc(I,j-1,k)) * grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdxCu(I,j) + + tot = sqrt( shr**2 + ten**2 ) * grid%mask2dT(i,j) + CS%skeb_diss(i,j,k) = tot**3 * kh * grid%areaT(i,j) !!**2 + enddo ; enddo + enddo + else ! This version has parentheses to preserve rotational symmetry when FMAs are enabled. + do k=1,GV%ke + do j=grid%jsc,grid%jec ; do i=grid%isc,grid%iec + ! Shear in [T-1 ~> s-1] + shr = ((vc(i,J,k)-vc(i-1,J,k)) * grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdxCv(i,J)) + & + ((uc(I,j,k)-uc(I,j-1,k)) * grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdyCu(I,j)) + ! Tension in [T-1 ~> s-1] + ten = ((vc(i,J,k)-vc(i-1,J,k)) * grid%mask2dCv(i,J)*grid%mask2dCv(i-1,J)*grid%IdyCv(i,J)) + & + ((uc(I,j,k)-uc(I,j-1,k)) * grid%mask2dCu(I,j)*grid%mask2dCu(I,j-1)*grid%IdxCu(I,j)) + + tot = sqrt( shr**2 + ten**2 ) * grid%mask2dT(i,j) + CS%skeb_diss(i,j,k) = tot**3 * kh * grid%areaT(i,j) !!**2 + enddo ; enddo + enddo + endif + endif ! Sets CS%skeb_diss in [L2 T-3 ~> m2 s-3] without GM or FrictWork ! smooth dissipation skeb_npass times do iter=1,CS%skeb_npass if (mod(iter,2) == 1) call pass_var(CS%skeb_diss, grid%domain) do k=1,GV%ke + if (CS%answer_date < 20250701) then + ! Do the filter with expressions that do not preserve rotational symmetry. + do j=grid%jsc-1,grid%jec+1 ; do i=grid%isc-1,grid%iec+1 + local_weights(:,:) = CS%area_wt(i-1:i+1,j-1:j+1) + diss_tmp(i,j) = sum(local_weights(:,:)*CS%skeb_diss(i-1:i+1,j-1:j+1,k)) / & + (sum(local_weights) + 1.e-16*US%m_to_L**2) + enddo ; enddo + else + ! This spatial filter preserves rotational symmeetry (including with FMAs), but is + ! mathematically equivalent to the older sum-based form above + do j=grid%jsc-1,grid%jec+1 ; do i=grid%isc-1,grid%iec+1 + sum_wtd_skeb_diss = CS%skeb_diss(i,j,k) * CS%area_wt(i+1,j) + & + ((( (CS%skeb_diss(i-1,j,k) * CS%area_wt(i-1,j)) + (CS%skeb_diss(i+1,j,k) * CS%area_wt(i+1,j)) ) + & + ( (CS%skeb_diss(i,j-1,k) * CS%area_wt(i,j-1)) + (CS%skeb_diss(i,j+1,k) * CS%area_wt(i,j+1)) )) + & + (( (CS%skeb_diss(i-1,j-1,k) * CS%area_wt(i-1,j-1)) + (CS%skeb_diss(i-1,j-1,k) * CS%area_wt(i+1,j+1)) ) + & + ( (CS%skeb_diss(i-1,j+1,k) * CS%area_wt(i-1,j+1)) + (CS%skeb_diss(i+1,j-1,k) * CS%area_wt(i+1,j-1)) ))) + diss_tmp(i,j) = sum_wtd_skeb_diss * CS%Isum_area_wts(i,j) + enddo ; enddo + endif do j=grid%jsc-1,grid%jec+1 ; do i=grid%isc-1,grid%iec+1 - ! This does not preserve rotational symmetry - local_weights = grid%mask2dT(i-1:i+1,j-1:j+1)*grid%areaT(i-1:i+1,j-1:j+1) - diss_tmp(i,j) = sum(local_weights*CS%skeb_diss(i-1:i+1,j-1:j+1,k)) / & - (sum(local_weights) + 1.E-16) - enddo ; enddo - do j=grid%jsc-1,grid%jec+1 ; do i=grid%isc-1,grid%iec+1 - if (grid%mask2dT(i,j)==0.) cycle - CS%skeb_diss(i,j,k) = diss_tmp(i,j) + CS%skeb_diss(i,j,k) = grid%mask2dT(i,j) * diss_tmp(i,j) enddo ; enddo enddo enddo call pass_var(CS%skeb_diss, grid%domain) - ! call hchksum(CS%skeb_diss, "SKEB DISS", grid%HI, haloshift=2) - ! call qchksum(CS%skeb_wts, "SKEB WTS", grid%HI, haloshift=1) + ! call hchksum(CS%skeb_diss, "SKEB DISS", grid%HI, haloshift=2, unscale=US%L_T_to_m_s**2*US%s_to_T) + ! call qchksum(CS%skeb_wts, "SKEB WTS", grid%HI, haloshift=1) ! SKEB_wts comes in from external code in mks units. do k=1,GV%ke do J=grid%jscB-1,grid%jecB ; do I=grid%iscB-1,grid%iecB + ! psi has units of [L2 T-1 ~> m2 s-1] because skeb_wts is in mks units of [m]. psi(I,J,k) = sqrt(0.25 * dt * max((CS%skeb_diss(i ,j ,k) + CS%skeb_diss(i+1,j+1,k)) + & (CS%skeb_diss(i ,j+1,k) + CS%skeb_diss(i+1,j ,k)), 0.) ) & - * CS%skeb_wts(I,J) + * US%m_to_L*CS%skeb_wts(I,J) enddo ; enddo enddo - !call qchksum(psi,"SKEB PSI", grid%HI, haloshift=1) + !call qchksum(psi,"SKEB PSI", grid%HI, haloshift=1, unscale=US%L_T_to_m_s*US%L_to_m) !call pass_var(psi, grid%domain, position=CORNER) do k=1,GV%ke do j=grid%jsc,grid%jec ; do I=grid%iscB,grid%iecB @@ -361,7 +429,7 @@ subroutine apply_skeb(grid,GV,CS,uc,vc,thickness,tv,dt,Time_end) enddo ; enddo enddo - !call uvchksum("SKEB increment [uv]", ustar, vstar, grid%HI) + !call uvchksum("SKEB increment [uv]", ustar, vstar, grid%HI, unscale=US%L_T_to_m_s) call enable_averages(dt, Time_end, CS%diag) if (CS%id_diss > 0) then @@ -393,7 +461,7 @@ end subroutine apply_skeb !! input fields have valid values in the first two halo points upon entry. subroutine smooth_x9_uv(G, field_u, field_v, zero_land) type(ocean_grid_type), intent(in) :: G !< Ocean grid - real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: field_u !< u-point field to be smoothed[arbitrary] + real, dimension(SZIB_(G),SZJ_(G)), intent(inout) :: field_u !< u-point field to be smoothed [arbitrary] real, dimension(SZI_(G),SZJB_(G)), intent(inout) :: field_v !< v-point field to be smoothed [arbitrary] logical, optional, intent(in) :: zero_land !< If present and false, return the average !! of the surrounding ocean points when @@ -449,6 +517,33 @@ subroutine smooth_x9_uv(G, field_u, field_v, zero_land) enddo end subroutine smooth_x9_uv - +!> \namespace mom_stochastics +!! +!! This file contains subroutines that implement some stochastic parameterizations in MOM6. +!! SPPT perturbations of the tendencies of S and T are turned on using DO_SPPT=True. +!! Stochastic perturbations in ePBL are turned on using PERT_EPBL=True. +!! Stochastic kinetic energy backscatter (SKEB) via the Stochastic GM+E scheme is turned on using +!! DO_SKEB=True. For all three schemes the spatial and temporal correlation structure +!! of the associated random fields is controlled from the nam_stochy namelist used by +!! the external stochastic_physics package, which is called by subroutines in this +!! module. +!! +!! The SKEB backscatter can be set in a variety of ways. If SKEB_USE_GM=True then +!! SKEB_GM_COEF times the GM work rate will be added to the backscatter rate. (The +!! vertical structure for this component of backscatter is the so-called EBT struct.) If +!! SKEB_USE_FRICT=True then SKEB_FRICT_COEF times the work rate from +!! lateral viscosity will be added to the backscatter rate. The code uses the total contribution +!! from Laplacian and biharmonic viscosities as computed within the horizontal viscosity module. +!! If neither SKEB_USE_GM nor SKEB_USE_FRICT is true, then the code +!! computes the dissipation rate as if it came from a lateral harmonic viscosity with +!! coefficient 1 (MKS units). The only thoroughly tested SKEB option at this point is +!! SKEB_USE_GM. +!! +!! The contributions to the backscatter rate are smoothed before use. One smoothing pass uses a +!! 3x3 moving average with weights proportional to the h-cell areas. The number of smoothing passes +!! is controlled by SKEB_NPASS. +!! +!! A taper is applied to the SKEB velocity increments (equivalently to the SKEB stochastic forcing). +!! The taper zeros out the increments near land cells. The width of this taper can be controlled using +!! SKEB_TAPER_WIDTH. end module MOM_stochastics - diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 6bbe582ce3..c72d25a260 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -34,6 +34,7 @@ module MOM_CVMix_KPP use CVMix_kpp, only : CVMix_kpp_params_type use CVMix_kpp, only : CVMix_kpp_compute_kOBL_depth use CVMix_kpp, only : CVMix_kpp_compute_StokesXi +use CVMix_kpp, only : CVMix_kpp_compute_ER_depth implicit none ; private @@ -48,6 +49,8 @@ module MOM_CVMix_KPP public :: KPP_NonLocalTransport_saln public :: KPP_NonLocalTransport public :: KPP_get_BLD +public :: KPP_get_Lam2 + ! Enumerated constants integer, private, parameter :: NLT_SHAPE_CVMix = 0 !< Use the CVMix profile @@ -83,7 +86,8 @@ module MOM_CVMix_KPP real :: vonKarman !< von Karman constant (dimensionless) [nondim] real :: cs !< Parameter for computing velocity scale function (dimensionless) [nondim] real :: cs2 !< Parameter for multiplying by non-local term [nondim] - ! This is active for NLT_SHAPE_CUBIC_LMD only + !! This is active for NLT_SHAPE_CUBIC_LMD only + real :: La_min !< An arbitrary lower-bound on the Langmuir number [nondim]. logical :: enhance_diffusion !< If True, add enhanced diffusivity at base of boundary layer. character(len=32) :: interpType !< Type of interpolation to compute bulk Richardson number character(len=32) :: interpType2 !< Type of interpolation to compute diff and visc at OBL_depth @@ -124,12 +128,19 @@ module MOM_CVMix_KPP real :: MLD_guess_min !< The minimum estimate of the mixed layer depth used to !! calculate the Langmuir number for Langmuir turbulence !! enhancement with KPP [Z ~> m] + real :: KPP_ER_Cb !< Entrainment Rule TKE buoyancy production weight [nondim] + real :: KPP_ER_Cs !< Entrainment Rule TKE Stokes production weight [nondim] + real :: KPP_ER_Cu !< Entrainment Rule TKE shear production weight [nondim] logical :: STOKES_MIXING !< Flag if model is mixing down Stokes gradient !! This is relevant for which current to use in RiB + logical :: OBL_depth_bounds_bug !< If true, limit the KPP boundary layer depth relative to + !! the top of the bottommost layer instead of the seafloor. integer :: answer_date !< The vintage of the order of arithmetic in the CVMix KPP !! calculations. Values below 20240501 recover the answers !! from early in 2024, while higher values use expressions - !! that have been refactored for rotational symmetry. + !! that have been refactored for rotational symmetry. Values + !! of 20260101 or higher replace some divisions with + !! multiplication by reciprocals. !> CVMix parameters type(CVMix_kpp_params_type), pointer :: KPP_params => NULL() @@ -149,39 +160,49 @@ module MOM_CVMix_KPP integer :: id_NLTt = -1 integer :: id_NLTs = -1 integer :: id_EnhK = -1, id_EnhVt2 = -1 - integer :: id_EnhW = -1 integer :: id_La_SL = -1 integer :: id_OBLdepth_original = -1 + integer :: id_ERdepth = -1, id_RNdepth = -1 integer :: id_StokesXI = -1 + integer :: id_BEdE_ER = -1 integer :: id_Lam2 = -1 + integer :: id_PU_TKE = -1 + integer :: id_PS_TKE = -1 + integer :: id_PB_TKE = -1 !>@} ! Diagnostics arrays real, pointer, dimension(:,:) :: OBLdepth !< Depth (positive) of ocean boundary layer (OBL) [Z ~> m] - real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL without smoothing [Z ~> m] - real, allocatable, dimension(:,:) :: StokesParXI !< Stokes similarity parameter [nondim] - real, allocatable, dimension(:,:) :: Lam2 !< La^(-2) = Ustk0/u* [nondim] - real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent [nondim] - real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [Z ~> m] - real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP [nondim] - real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] - real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [L2 T-2 ~> m2 s-2] + real, pointer, dimension(:,:) :: Lam2 !< La^(-2) = Ustk0/u* [nondim] real, allocatable, dimension(:,:,:) :: BulkRi !< Bulk Richardson number for each layer [nondim] - real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) [nondim] - real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [Z T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: N !< Brunt-Vaisala frequency [T-1 ~> s-1] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] - real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved squared turbulence velocity for - !! bulk Ri [Z2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: Ws !< Turbulent velocity scale for scalars [Z T-1 ~> m s-1] + real, allocatable, dimension(:,:,:) :: Vt2 !< Unresolved turbulence velocity^2 for bulk Ri [Z2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: Uz2 !< Square of bulk difference in resolved velocity [L2 T-2 ~> m2 s-2] + real, allocatable, dimension(:,:,:) :: dRho !< Bulk difference in density [R ~> kg m-3] + real, allocatable, dimension(:,:,:) :: sigma !< Sigma coordinate (dimensionless) [nondim] + real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: Kt_KPP !< Temp diffusivity from KPP [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:,:) :: Ks_KPP !< Scalar diffusivity from KPP [Z2 T-1 ~> m2 s-1] - real, allocatable, dimension(:,:,:) :: Kv_KPP !< Viscosity due to KPP [Z2 T-1 ~> m2 s-1] real, allocatable, dimension(:,:) :: Tsurf !< Temperature of surface layer [C ~> degC] real, allocatable, dimension(:,:) :: Ssurf !< Salinity of surface layer [S ~> ppt] real, allocatable, dimension(:,:) :: Usurf !< i-velocity of surface layer [L T-1 ~> m s-1] real, allocatable, dimension(:,:) :: Vsurf !< j-velocity of surface layer [L T-1 ~> m s-1] real, allocatable, dimension(:,:,:) :: EnhK !< Enhancement for mixing coefficient [nondim] real, allocatable, dimension(:,:,:) :: EnhVt2 !< Enhancement for Vt2 [nondim] + real, allocatable, dimension(:,:) :: La_SL !< Langmuir number used in KPP [nondim] + real, allocatable, dimension(:,:) :: OBLdepth_original !< Depth (positive) of OBL [Z ~> m] without smoothing + real, allocatable, dimension(:,:) :: ERdepth !< Percent use ER boundary layer depth [nondim] + real, allocatable, dimension(:,:) :: RNdepth !< Percent use Ri Number boundary layer depth [nondim] + real, allocatable, dimension(:,:) :: StokesXI !< Stokes similarity parameter [nondim] + real, allocatable, dimension(:,:) :: BEdE_ER !< Entrainment Rule's Parameterized BEdE [ m3 s-3 ] + ! Other arrays + real, allocatable, dimension(:,:) :: kOBL !< Level (+fraction) of OBL extent [nondim] + real, allocatable, dimension(:,:) :: OBLdepthprev !< previous Depth (positive) of OBL [Z ~> m] + real, pointer, dimension(:,:) :: PU_TKE !< Parameterized shear TKE Production [ m3 s-3 ] + real, pointer, dimension(:,:) :: PS_TKE !< Parameterized Stokes TKE Production [ m3 s-3 ] + real, pointer, dimension(:,:) :: PB_TKE !< Parameterized buoyancy TKE Production [ m3 s-3 ] end type KPP_CS @@ -353,7 +374,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) 'Over-rides the result from CVMix. Allowed values are: \n'// & '\t CVMix - Uses the profiles from CVMix specified by MATCH_TECHNIQUE\n'//& '\t LINEAR - A linear profile, 1-sigma\n'// & - '\t PARABOLIC - A parablic profile, (1-sigma)^2\n'// & + '\t PARABOLIC - A parabolic profile, (1-sigma)^2\n'// & '\t CUBIC - A cubic profile, (1-sigma)^2(1+2*sigma)\n'// & '\t CUBIC_LMD - The original KPP profile', & default='CVMix') @@ -421,10 +442,10 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) !/BGR: New options for including Langmuir effects !/ 1. Options related to enhancing the mixing coefficient call get_param(paramFile, mdl, "USE_KPP_LT_K", CS%LT_K_Enhancement, & - 'Flag for Langmuir turbulence enhancement of turbulent'//& + 'Flag for Langmuir turbulence enhancement of turbulent '//& 'mixing coefficient.', Default=.false.) call get_param(paramFile, mdl, "STOKES_MIXING", CS%Stokes_Mixing, & - 'Flag for Langmuir turbulence enhancement of turbulent'//& + 'Flag for Langmuir turbulence enhancement of turbulent '//& 'mixing coefficient.', Default=.false.) if (CS%LT_K_Enhancement) then call get_param(paramFile, mdl, 'KPP_LT_K_SHAPE', string, & @@ -471,7 +492,7 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) endif !/ 2. Options related to enhancing the unresolved Vt2/entrainment in Rib call get_param(paramFile, mdl, "USE_KPP_LT_VT2", CS%LT_Vt2_Enhancement, & - 'Flag for Langmuir turbulence enhancement of Vt2'//& + 'Flag for Langmuir turbulence enhancement of Vt2 '//& 'in Bulk Richardson Number.', Default=.false.) if (CS%LT_Vt2_Enhancement) then call get_param(paramFile, mdl, "KPP_LT_VT2_METHOD",string , & @@ -518,25 +539,49 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) endif call get_param(paramFile, mdl, "KPP_CVt2", CS%KPP_CVt2, & - 'Parameter for Stokes MOST convection entrainment', & + 'Parameter for Stokes MOST convection entrainment (unresolved shear)', & units="nondim", default=1.6) + call get_param(paramFile, mdl, "KPP_ER_Cb", CS%KPP_ER_Cb, & + 'Entrainment Rule TKE buoyancy production weight', & + units="nondim", default=0.96) + call get_param(paramFile, mdl, "KPP_ER_Cs", CS%KPP_ER_Cs, & + 'Entrainment Rule TKE Stokes production weight', & + units="nondim", default=0.038) + call get_param(paramFile, mdl, "KPP_ER_Cu", CS%KPP_ER_Cu, & + 'Entrainment Rule TKE shear production weight', & + units="nondim", default=0.023) + + call get_param(paramFile, mdl, "KPP_OBL_DEPTH_BOUNDS_BUG", CS%OBL_depth_bounds_bug, & + "If true, limit the KPP boundary layer depth relative to the top of the "//& + "bottommost layer instead of the seafloor.", & + default=.false.) call get_param(paramFile, mdl, "ANSWER_DATE", CS%answer_date, & "The vintage of the order of arithmetic in the CVMix KPP calculations. Values "//& "below 20240501 recover the answers from early in 2024, while higher values "//& - "use expressions that have been refactored for rotational symmetry.", & + "use expressions that have been refactored for rotational symmetry. Values of "//& + "20260101 or higher replace some divisions with multiplication by reciprocals.", & default=default_answer_date) call closeParameterBlock(paramFile) call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + call get_param(paramFile, mdl, "MIN_LANGMUIR", CS%La_min, & + "A minimum value for all Langmuir numbers that is not physical, "//& + "but is likely only encountered when the wind is very small and "//& + "therefore its effects should be mostly benign.", & + units="nondim", default=0.05, do_not_log=.true.) + call CVMix_init_kpp( Ri_crit=CS%Ri_crit, & minOBLdepth=US%Z_to_m*CS%minOBLdepth, & minVtsqr=US%L_T_to_m_s**2*CS%minVtsqr, & vonKarman=CS%vonKarman, & surf_layer_ext=CS%surf_layer_ext, & CVt2=CS%KPP_CVt2, & + ER_Cb=CS%KPP_ER_Cb, & + ER_Cs=CS%KPP_ER_Cs, & + ER_Cu=CS%KPP_ER_Cu, & interp_type=CS%interpType, & interp_type2=CS%interpType2, & lEkman=CS%computeEkman, & @@ -567,51 +612,39 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) cmor_field_name='oml', cmor_long_name='ocean_mixed_layer_thickness_defined_by_mixing_scheme', & cmor_units='m', cmor_standard_name='Ocean Mixed Layer Thickness Defined by Mixing Scheme') endif - if( CS%StokesMOST ) then - CS%id_StokesXI = register_diag_field('ocean_model', 'StokesXI', diag%axesT1, Time, & - 'Stokes Similarity Parameter', 'nondim') - CS%id_Lam2 = register_diag_field('ocean_model', 'Lam2', diag%axesT1, Time, & - 'Ustk0_ustar', 'nondim') - endif - CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & - 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', & - 'kg/m3', conversion=US%R_to_kg_m3) - CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & - 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', & - 'm2/s2', conversion=US%L_T_to_m_s**2) CS%id_BulkRi = register_diag_field('ocean_model', 'KPP_BulkRi', diag%axesTL, Time, & 'Bulk Richardson number used to find the OBL depth used by [CVMix] KPP', 'nondim') - CS%id_Sigma = register_diag_field('ocean_model', 'KPP_sigma', diag%axesTi, Time, & - 'Sigma coordinate used by [CVMix] KPP', 'nondim') - CS%id_Ws = register_diag_field('ocean_model', 'KPP_Ws', diag%axesTL, Time, & - 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', & - 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_N = register_diag_field('ocean_model', 'KPP_N', diag%axesTi, Time, & '(Adjusted) Brunt-Vaisala frequency used by [CVMix] KPP', '1/s', conversion=US%s_to_T) CS%id_N2 = register_diag_field('ocean_model', 'KPP_N2', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by [CVMix] KPP', '1/s2', conversion=US%s_to_T**2) + CS%id_Ws = register_diag_field('ocean_model', 'KPP_Ws', diag%axesTL, Time, & + 'Turbulent vertical velocity scale for scalars used by [CVMix] KPP', & + 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_Vt2 = register_diag_field('ocean_model', 'KPP_Vt2', diag%axesTL, Time, & 'Unresolved shear turbulence used by [CVMix] KPP', 'm2/s2', conversion=US%Z_to_m**2*US%s_to_T**2) + CS%id_BulkUz2 = register_diag_field('ocean_model', 'KPP_BulkUz2', diag%axesTL, Time, & + 'Square of bulk difference in resolved velocity used in Bulk Richardson number via [CVMix] KPP', & + 'm2/s2', conversion=US%L_T_to_m_s**2) + CS%id_BulkDrho = register_diag_field('ocean_model', 'KPP_BulkDrho', diag%axesTL, Time, & + 'Bulk difference in density used in Bulk Richardson number, as used by [CVMix] KPP', & + 'kg/m3', conversion=US%R_to_kg_m3) CS%id_uStar = register_diag_field('ocean_model', 'KPP_uStar', diag%axesT1, Time, & 'Friction velocity, u*, as used by [CVMix] KPP', 'm/s', conversion=US%Z_to_m*US%s_to_T) CS%id_buoyFlux = register_diag_field('ocean_model', 'KPP_buoyFlux', diag%axesTi, Time, & 'Surface (and penetrating) buoyancy flux, as used by [CVMix] KPP', & 'm2/s3', conversion=US%L_to_m**2*US%s_to_T**3) + CS%id_Sigma = register_diag_field('ocean_model', 'KPP_sigma', diag%axesTi, Time, & + 'Sigma coordinate used by [CVMix] KPP', 'nondim') + CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & + 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', & + 'm2/s', conversion=US%Z2_T_to_m2_s) CS%id_Kt_KPP = register_diag_field('ocean_model', 'KPP_Kheat', diag%axesTi, Time, & 'Heat diffusivity due to KPP, as calculated by [CVMix] KPP', & 'm2/s', conversion=US%Z2_T_to_m2_s) - CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & - 'Diffusivity passed to KPP', 'm2/s', conversion=GV%HZ_T_to_m2_s) CS%id_Ks_KPP = register_diag_field('ocean_model', 'KPP_Ksalt', diag%axesTi, Time, & 'Salt diffusivity due to KPP, as calculated by [CVMix] KPP', & 'm2/s', conversion=US%Z2_T_to_m2_s) - CS%id_Kv_KPP = register_diag_field('ocean_model', 'KPP_Kv', diag%axesTi, Time, & - 'Vertical viscosity due to KPP, as calculated by [CVMix] KPP', & - 'm2/s', conversion=US%Z2_T_to_m2_s) - CS%id_NLTt = register_diag_field('ocean_model', 'KPP_NLtransport_heat', diag%axesTi, Time, & - 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') - CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & - 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_Tsurf = register_diag_field('ocean_model', 'KPP_Tsurf', diag%axesT1, Time, & 'Temperature of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & 'C', conversion=US%C_to_degC) @@ -624,6 +657,12 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_Vsurf = register_diag_field('ocean_model', 'KPP_Vsurf', diag%axesCv1, Time, & 'j-component flow of surface layer (10% of OBL depth) as passed to [CVMix] KPP', & 'm/s', conversion=US%L_T_to_m_s) + CS%id_Kd_in = register_diag_field('ocean_model', 'KPP_Kd_in', diag%axesTi, Time, & + 'Diffusivity passed to KPP', 'm2/s', conversion=GV%HZ_T_to_m2_s) + CS%id_NLTt = register_diag_field('ocean_model', 'KPP_NLtransport_heat', diag%axesTi, Time, & + 'Non-local transport (Cs*G(sigma)) for heat, as calculated by [CVMix] KPP', 'nondim') + CS%id_NLTs = register_diag_field('ocean_model', 'KPP_NLtransport_salt', diag%axesTi, Time, & + 'Non-local tranpsort (Cs*G(sigma)) for scalars, as calculated by [CVMix] KPP', 'nondim') CS%id_EnhK = register_diag_field('ocean_model', 'EnhK', diag%axesTI, Time, & 'Langmuir number enhancement to K as used by [CVMix] KPP','nondim') CS%id_EnhVt2 = register_diag_field('ocean_model', 'EnhVt2', diag%axesTL, Time, & @@ -631,30 +670,57 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive) CS%id_La_SL = register_diag_field('ocean_model', 'KPP_La_SL', diag%axesT1, Time, & 'Surface-layer Langmuir number computed in [CVMix] KPP','nondim') + ! only available when StokesMOST is enabled + if (CS%StokesMOST) then + CS%id_ERdepth = register_diag_field('ocean_model', 'ERdepth', diag%axesT1, Time, & + 'Entrainment Rule Boundary Layer depth percent', 'nondim') + CS%id_RNdepth = register_diag_field('ocean_model', 'RNdepth', diag%axesT1, Time, & + 'Richardson Number Boundary Layer depth percent', 'nondim') + CS%id_StokesXI = register_diag_field('ocean_model', 'StokesXI', diag%axesT1, Time, & + 'Stokes Similarity Parameter', 'nondim') + CS%id_Lam2 = register_diag_field('ocean_model', 'Lam2', diag%axesT1, Time, & + 'Ustk0/ustar', 'nondim') + CS%id_BEdE_ER = register_diag_field('ocean_model', 'BEdE_ER', diag%axesT1, Time, & + 'Entrainment Rule BEdE_ER', 'm3 s-3', conversion=1.0) + CS%id_PU_TKE = register_diag_field('ocean_model', 'PU_TKE' , diag%axesT1, Time, & + 'Shear production of surface layer TKE', 'm3 s-3', conversion=1.0) + CS%id_PS_TKE = register_diag_field('ocean_model', 'PS_TKE' , diag%axesT1, Time, & + 'Stokes production of surface layer TKE', 'm3 s-3', conversion=1.0) + CS%id_PB_TKE = register_diag_field('ocean_model', 'PB_TKE' , diag%axesT1, Time, & + 'Buoyancy production of surface layer TKE', 'm3 s-3', conversion=1.0) + ! arrays only needed when StokesMOST is enabled + allocate( CS%Lam2 ( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%PU_TKE( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%PS_TKE( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%PB_TKE( SZI_(G), SZJ_(G) ), source=0. ) + endif + allocate( CS%N( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) - allocate( CS%StokesParXI( SZI_(G), SZJ_(G) ), source=0. ) - allocate( CS%Lam2 ( SZI_(G), SZJ_(G) ), source=0. ) - allocate( CS%kOBL( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%StokesXI( SZI_(G), SZJ_(G) ), source=0. ) allocate( CS%La_SL( SZI_(G), SZJ_(G) ), source=0. ) allocate( CS%Vt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) - if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - + allocate( CS%kOBL( SZI_(G), SZJ_(G) ), source=0. ) allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ), source=0.0 ) - if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) - if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + allocate( CS%ERdepth( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%RNdepth( SZI_(G), SZJ_(G) ), source=0. ) + if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) - if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) - if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) - if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G) ), source=0. ) if (CS%id_Ssurf > 0) allocate( CS%Ssurf( SZI_(G), SZJ_(G) ), source=0. ) if (CS%id_Usurf > 0) allocate( CS%Usurf( SZIB_(G), SZJ_(G) ), source=0. ) if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G) ), source=0. ) if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) + if (CS%id_BEdE_ER > 0) allocate( CS%BEdE_ER( SZI_(G), SZJ_(G) ), source=0. ) id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) id_clock_KPP_compute_BLD = cpu_clock_id('(Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) @@ -854,7 +920,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & GV%ke, & ! (in) Number of levels to compute coeffs for GV%ke, & ! (in) Number of levels in array shape Langmuir_EFactor=LangEnhK,& ! Langmuir enhancement multiplier - StokesXi = CS%StokesParXI(i,j), & ! Stokes forcing parameter + StokesXi = CS%StokesXI(i,j), & ! Stokes forcing parameter CVMix_kpp_params_user=CS%KPP_params ) ! safety check, Kviscosity and Kdiffusivity must be >= 0 @@ -878,7 +944,7 @@ subroutine KPP_calculate(CS, G, GV, US, h, tv, uStar, buoyFlux, Kt, Ks, Kv, & call MOM_error(FATAL,"KPP_calculate, after CVMix_coeffs_kpp: "// & "Negative vertical viscosity or diffusivity has been detected. " // & - "This is likely related to the choice of MATCH_TECHNIQUE and INTERP_TYPE2." //& + "This is likely related to the choice of MATCH_TECHNIQUE and INTERP_TYPE2. " //& "You might consider using the default options for these parameters." ) endif enddo @@ -1027,6 +1093,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real, dimension( GV%ke+1 ) :: N_col ! A column of buoyancy frequencies at interfaces in MKS units [s-1] real :: surfFricVel ! Surface friction velocity in MKS units [m s-1] real :: surfBuoyFlux ! Surface buoyancy flux in MKS units [m2 s-3] + real :: surfBuoy_NS ! Non-solar surface buoyancy flux in MKS units [L2 T-3 ~> m2 s-3] + real :: etaDk ! Approximate solar decay from surfBuoyFlux2 (2) and (3) [Z-1 ~> m-1] real :: Coriolis ! Coriolis parameter at tracer points in MKS units [s-1] real :: KPP_OBL_depth ! Boundary layer depth calculated by CVMix_kpp_compute_OBL_depth in MKS units [m] @@ -1055,7 +1123,7 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: surfSalt ! Average of salinity over the surface layer [S ~> ppt] real :: surfHsalt ! Integral of salinity over the surface layer [Z S ~> m ppt] real :: surfHu, surfHv ! Integral of u and v over the surface layer [Z L T-1 ~> m2 s-1] - real :: surfU, surfV ! Average of u and v over the surface layer [Z T-1 ~> m s-1] + real :: surfU, surfV ! Average of u and v over the surface layer [L T-1 ~> m s-1] real :: dh ! The local thickness used for calculating interface positions [Z ~> m] real :: hcorr ! A cumulative correction arising from inflation of vanished layers [Z ~> m] @@ -1066,20 +1134,25 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl real :: MLD_guess ! A guess at the mixed layer depth for calculating the Langmuir number [Z ~> m] real :: LA ! The local Langmuir number [nondim] real :: surfHuS, surfHvS ! Stokes drift velocities integrated over the boundary layer [Z L T-1 ~> m2 s-1] - real :: surfUs, surfVs ! Stokes drift velocities averaged over the boundary layer [Z T-1 ~> m s-1] - - integer :: i, j, k, km1, kk, ksfc, ktmp ! Loop indices + real :: surfUs, surfVs ! Stokes drift velocities averaged over the boundary layer [L T-1 ~> m s-1] + integer :: i, j, k, km1, kk, ksfc, ktmp ! Loop indices real, dimension(GV%ke) :: uE_H, vE_H ! Eulerian velocities h-points, centers [L T-1 ~> m s-1] real, dimension(GV%ke) :: uS_H, vS_H ! Stokes drift components h-points, centers [L T-1 ~> m s-1] real, dimension(GV%ke) :: uSbar_H, vSbar_H ! Cell Average Stokes drift h-points [L T-1 ~> m s-1] real, dimension(GV%ke+1) :: uS_Hi, vS_Hi ! Stokes Drift components at interfaces [L T-1 ~> m s-1] - real :: uS_SLD , vS_SLD, uS_SLC , vS_SLC, uSbar_SLD, vSbar_SLD ! Stokes at/to to Surface Layer Extent - ! [L T-1 ~> m s-1] + real :: uS_SL, vS_SL ! Stokes at Surface Layer Depth [L T-1 ~> m s-1] + real :: uSb_SL, vSb_SL ! Average Stokes to Surface Layer Depths [L T-1 ~> m s-1] + real :: uS_Hi_mag ! The magnitude of the Stokes drift at interfaces in MKS units [m s-1] real :: StokesXI ! Stokes similarity parameter [nondim] - real, dimension( GV%ke ) :: StokesXI_1d , StokesVt_1d ! Parameters of TKE production ratio [nondim] - real :: Llimit ! Stable boundary Layer Limit = vonk Lstar [Z ~> m] - integer :: kbl ! index of cell containing boundary layer depth + real :: BEdE_ER ! Entrainment Rule [ m3 s-3 ] + real :: PU_TKE, PS_TKE, PB_TKE ! Shear, Stokes, Buoyancy TKE production rate [ m3 s-3 ] + real, dimension( GV%ke ) :: StokesXI_1d ! Parameters of TKE production ratio [nondim] + real, dimension( GV%ke ) :: BEdE_ER_1d ! Entrainment Rule parameterized [ m3 s-3 ] + real :: ERdepth ! Entrainment Rule Boundary layer depth CVMix_kpp_compute_ER_depth in MKS units [m] + real :: Llimit ! Stable boundary Layer Limit = vonk Lstar [Z ~> m] + integer :: kbl ! index of cell containing boundary layer depth [nondim] + real :: Lam2_max ! Upper bound for Lam2 [nondim] if (CS%Stokes_Mixing .and. .not.associated(Waves)) call MOM_error(FATAL, & "KPP_compute_BLD: The Waves control structure must be associated if STOKES_MIXING is True.") @@ -1102,6 +1175,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif buoy_scale = US%L_to_m**2*US%s_to_T**3 + Lam2_max = CS%La_min**(-2) + ! Find the vertical distances across layers. call thickness_to_dz(h, tv, dz, G, GV, US) @@ -1114,28 +1189,44 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl !$OMP Temp_1D, salt_1D, surfBuoyFlux2, MLD_guess, LA, rho_1D, & !$OMP deltarho, deltaBuoy, N2_1d, ws_1d, LangEnhVT2,KPP_OBL_depth, z_cell, & !$OMP z_inter, OBL_depth, BulkRi_1d, zBottomMinusOffset, uE_H, vE_H, & - !$OMP uS_H, vS_H, uSbar_H, vSbar_H , uS_Hi, vS_Hi, & - !$OMP uS_SLD, vS_SLD, uS_SLC, vS_SLC, uSbar_SLD, vSbar_SLD, & - !$OMP StokesXI, StokesXI_1d, StokesVt_1d, kbl) & + !$OMP uS_H, vS_H, uSbar_H, vSbar_H , uS_Hi, vS_Hi, uSb_SL, vSb_SL, & + !$OMP uS_SL, vS_SL, StokesXI, StokesXI_1d, surfBuoy_NS, etadk, & + !$OMP BEdE_ER_1d, ERdepth, BEdE_ER, PU_TKE, PS_TKE, PB_TKE, kbl), & !$OMP shared(G, GV, CS, US, uStar, h, dz, buoy_scale, buoyFlux, & - !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult, Vt_layer) + !$OMP Temp, Salt, waves, tv, GoRho, GoRho_Z_L2, u, v, lamult, & + !$OMP Vt_layer, uS_Hi_mag, Lam2_max) + do j = G%jsc, G%jec do i = G%isc, G%iec ; if (G%mask2dT(i,j) > 0.0) then + iFaceHeight(:) = 0.0 ! BBL is always relative to the surface iFaceHeight(1) + do k=1,GV%ke U_H(k) = 0.5 * (u(I,j,k)+u(I-1,j,k)) V_H(k) = 0.5 * (v(i,J,k)+v(i,J-1,k)) enddo + if (CS%StokesMOST) then - do k=1,GV%ke - uE_H(k) = 0.5 * (u(I,j,k)+u(I-1,j,k)-Waves%US_x(I,j,k)-Waves%US_x(I-1,j,k)) - vE_H(k) = 0.5 * (v(i,J,k)+v(i,J-1,k)-Waves%US_y(i,J,k)-Waves%US_y(i,J-1,k)) - enddo + ! Load surface Stokes uS_Hi(1), vS_Hi(1); 1.0 is a dummy number + call Compute_StokesDrift(i, j, 1.0, iFaceHeight(1), & + 0.5*dz(i,j,1), iFaceHeight(1), -dz(i,j,1), & ! zBL, zSLtop, zSL + uS_Hi(1), vS_Hi(1), uS_H(1), vS_H(1), uS_SL, vS_SL, & + uSbar_H(1), vSbar_H(1), uSb_SL, vSb_SL, waves) endif + ! things independent of position within the column Coriolis = 0.25*US%s_to_T*( (G%CoriolisBu(i,j) + G%CoriolisBu(i-1,j-1)) + & (G%CoriolisBu(i-1,j) + G%CoriolisBu(i,j-1)) ) surfFricVel = US%Z_to_m*US%s_to_T * uStar(i,j) + ! Estimate non-solar surface buoyancy flux + ! Ideally, this should be provided to this subroutine. However, right now only the + ! total surface flux (solar + non-solar) is provided. + surfBuoy_NS = 0.0 ! temporary surface solar + if ( (buoyFlux(i,j,3) > 0.0) .and. (buoyFlux(i,j,3) < buoyFlux(i,j,2)) ) then + etaDk = alog(buoyFlux(i,j,2)/buoyFlux(i,j,3)) / (dz(i,j,2) + GV%dz_subroundoff) ! (z_inter(2)-z_inter(3)) + surfBuoy_NS = buoyFlux(i,j,2) * exp( -etaDk * dz(i,j,1) ) ! Approximate surface solar buoyancy flux + endif + surfBuoy_NS = buoyFlux(i,j,1) - surfBuoy_NS ! Total - solar = non-solar surface buoyancy flux ! Bulk Richardson number computed for each cell in a column, ! assuming OBLdepth = grid cell depth. After Rib(k) is @@ -1143,16 +1234,12 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl ! the actual OBLdepth. This approach avoids need to iterate ! on the OBLdepth calculation. It follows that used in MOM5 ! and POP. - iFaceHeight(1) = 0.0 ! BBL is all relative to the surface pRef = 0. ; if (associated(tv%p_surf)) pRef = tv%p_surf(i,j) hcorr = 0. - if (CS%StokesMOST) call Compute_StokesDrift( i, j, h(i,j,1) , iFaceHeight(1), & - uS_Hi(1), vS_Hi(1), uS_H(1), vS_H(1), uSbar_H(1), vSbar_H(1), Waves) - do k=1,GV%ke ! cell center and cell bottom in meters (negative values in the ocean) - dh = dz(i,j,k) ! Nominal thickness to use for increment + dh = dz(i,j,k) ! Nominal thickness to use for increment dh = dh + hcorr ! Take away the accumulated error (could temporarily make dh<0) hcorr = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness @@ -1175,22 +1262,48 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfBuoyFlux = buoy_scale * & (buoyFlux(i,j,1) - 0.5*(buoyFlux(i,j,max(2,k))+buoyFlux(i,j,k+1)) ) surfBuoyFlux2(k) = surfBuoyFlux + call Compute_StokesDrift(i,j, iFaceHeight(k),iFaceHeight(k+1), & - uS_Hi(k+1), vS_Hi(k+1), uS_H(k), vS_H(k), uSbar_H(k), vSbar_H(k), Waves) - call Compute_StokesDrift(i,j, iFaceHeight(ksfc) , -SLdepth_0d, & - uS_SLD , vS_SLD, uS_SLC , vS_SLC, uSbar_SLD, vSbar_SLD, Waves) - call cvmix_kpp_compute_StokesXi( iFaceHeight,CellHeight,ksfc ,SLdepth_0d,surfBuoyFlux, & - surfFricVel,waves%omega_w2x(i,j), uE_H, vE_H, uS_Hi, vS_Hi, uSbar_H, vSbar_H, uS_SLD,& - vS_SLD, uSbar_SLD, vSbar_SLD, StokesXI, CVMix_kpp_params_user=CS%KPP_params ) + cellHeight(k),iFaceHeight(ksfc),-SLdepth_0d, & + uS_Hi(k+1), vS_Hi(k+1), uS_H(k), vS_H(k), uS_SL, vS_SL, & + uSbar_H(k), vSbar_H(k), uSb_SL, vSb_SL, waves) + uE_H(k) = U_H(k) - 0.5 * (Waves%US_x(I,j,k)+Waves%US_x(I-1,j,k)) + vE_H(k) = V_H(k) - 0.5 * (Waves%US_y(i,J,k)+Waves%US_y(i,J-1,k)) + + call cvmix_kpp_compute_StokesXi( & + iFaceHeight*US%Z_to_m, & ! (in) Cell interface height [m] + CellHeight*US%Z_to_m, & ! (in) Cell center height [m] + ksfc, & ! (in) Cell index of Surface Layer Depth + SLdepth_0d*US%Z_to_m, & ! (in) Surface Layer Depth [m] + surfBuoyFlux, & ! (in) Surface buoyancy flux [m2 s-3] + surfBuoy_NS*buoy_scale, & ! (in) Non-solar surface buoyancy flux [m2 s-3] + surfFricVel, & ! (in) Surface wind forcing from x-axis [m s-1] + waves%omega_w2x(i,j), & ! (in) Wind direction ccw from model x- axis [nondim radians] + uE_H*US%L_T_to_m_s, & ! (in) Eulerian velocity at cell centers [m s-1] + vE_H*US%L_T_to_m_s, & ! (in) Eulerian velocity at cell centers [m s-1] + uS_Hi*US%L_T_to_m_s, & ! (in) Stokes drift at interfaces [m s-1] + vS_Hi*US%L_T_to_m_s, & ! (in) Stokes drift at interfaces [m s-1] + uSbar_H*US%L_T_to_m_s, & ! (in) Cell average Stokes drift [m s-1] + vSbar_H*US%L_T_to_m_s, & ! (in) Cell average Stokes drift [m s-1] + uS_SL*US%L_T_to_m_s, & ! (in) Stokes drift at SLDepth [m s-1] + vS_SL*US%L_T_to_m_s, & ! (in) Stokes drift at SLDepth [m s-1] + uSb_SL*US%L_T_to_m_s, & ! (in) Average Stokes drift cell top to SLDepth [m s-1] + vSb_SL*US%L_T_to_m_s, & ! (in) Average Stokes drift cell top to SLDepth [m s-1] + StokesXI, & ! (inout) Stokes XI similarity parameter [nondim] + BEdE_ER, & ! (inout) Entrainment rule product [m3 s-3] + PU_TKE, PS_TKE, PB_TKE, & ! (inout) Shear, Stokes, Buoyancy SL TKE Production [m3 s-3] + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + ! Save 1D Stokes XI similarity parameter and entrainment rule StokesXI_1d(k) = StokesXI - StokesVt_1d(k) = 0.0 ! StokesXI + BEdE_ER_1d(k) = BEdE_ER ! average temperature, salinity, u and v over surface layer starting at ksfc delH = SLdepth_0d + iFaceHeight(ksfc) surfHtemp = Temp(i,j,ksfc) * delH surfHsalt = Salt(i,j,ksfc) * delH - surfHu = (uE_H(ksfc) + uSbar_SLD) * delH - surfHv = (vE_H(ksfc) + vSbar_SLD) * delH + surfHu = (uE_H(ksfc) + uSb_SL) * delH + surfHv = (vE_H(ksfc) + vSb_SL) * delH hTot = delH do ktmp = 1,ksfc-1 ! if ksfc >=2 delH = h(i,j,ktmp)*GV%H_to_Z @@ -1206,8 +1319,8 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfU = surfHu * I_hTot surfV = surfHv * I_hTot - Uk = uE_H(k) + uS_H(k) - surfU - Vk = vE_H(k) + vS_H(k) - surfV + Uk = u_H(k) - surfU + Vk = v_H(k) - surfV else !not StokesMOST StokesXI_1d(k) = 0.0 @@ -1221,13 +1334,10 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl surfHvS = 0.0 hTot = 0.0 do ktmp = 1,ksfc - ! SLdepth_0d can be between cell interfaces delH = min( max(0.0, SLdepth_0d - hTot), dz(i,j,ktmp) ) - ! surface layer thickness hTot = hTot + delH - ! surface averaged fields surfHtemp = surfHtemp + Temp(i,j,ktmp) * delH surfHsalt = surfHsalt + Salt(i,j,ktmp) * delH @@ -1239,24 +1349,27 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl endif enddo - !I_hTot = 1./hTot - !surfTemp = surfHtemp * I_hTot - !surfSalt = surfHsalt * I_hTot - !surfU = surfHu * I_hTot - !surfV = surfHv * I_hTot - !surfUs = surfHus * I_hTot - !surfVs = surfHvs * I_hTot - - surfTemp = surfHtemp / hTot - surfSalt = surfHsalt / hTot - surfU = surfHu / hTot - surfV = surfHv / hTot - surfUs = surfHus / hTot - surfVs = surfHvs / hTot + if (CS%answer_date < 20260101) then + surfTemp = surfHtemp / hTot + surfSalt = surfHsalt / hTot + surfU = surfHu / hTot + surfV = surfHv / hTot + surfUs = surfHus / hTot + surfVs = surfHvs / hTot + else + I_hTot = 1./hTot + surfTemp = surfHtemp * I_hTot + surfSalt = surfHsalt * I_hTot + surfU = surfHu * I_hTot + surfV = surfHv * I_hTot + surfUs = surfHus * I_hTot + surfVs = surfHvs * I_hTot + endif + ! vertical shear between present layer and surface layer averaged surfU and surfV. ! C-grid average to get Uk and Vk on T-points. - Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU - Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV + Uk = 0.5*(u(i,j,k)+u(i-1,j,k)) - surfU + Vk = 0.5*(v(i,j,k)+v(i,j-1,k)) - surfV if (CS%Stokes_Mixing) then ! If momentum is mixed down the Stokes drift gradient, then @@ -1296,14 +1409,13 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl enddo ! k-loop finishes - if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT) .and. .not. present(lamult)) then + if ( (CS%LT_K_ENHANCEMENT .or. CS%LT_VT2_ENHANCEMENT)) then MLD_guess = max( CS%MLD_guess_min, abs(CS%OBLdepthprev(i,j) ) ) call get_Langmuir_Number(LA, G, GV, US, MLD_guess, uStar(i,j), i, j, & dz=dz(i,j,:), U_H=U_H, V_H=V_H, WAVES=WAVES) CS%La_SL(i,j) = LA endif - ! compute in-situ density call calculate_density(Temp_1D, Salt_1D, pres_1D, rho_1D, tv%eqn_of_state) @@ -1337,45 +1449,78 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl z_inter(K) = US%Z_to_m*iFaceHeight(K) enddo - ! CVMix_kpp_compute_turbulent_scales_1d_OBL computes w_s velocity scale at cell centers for - ! CVmix_kpp_compute_bulk_Richardson call to CVmix_kpp_compute_unresolved_shear - ! at sigma=Vt_layer (CS%surf_layer_ext or 1.0) for this calculation. - ! StokesVt_1d controls Stokes enhancement (= 0 for none) - Vt_layer = 1.0 ! CS%surf_layer_ext - call CVMix_kpp_compute_turbulent_scales( & ! 1d_OBL + ! Use CS%deepOBLoffset (<-0.1*iFaceHeight(GV%ke+1)) to avoid vanishingly small layers near the bottom. + if (CS%OBL_depth_bounds_bug) then + zBottomMinusOffset = iFaceHeight(GV%ke) + min( max(CS%deepOBLoffset,0.0), -0.1*iFaceHeight(GV%ke+1)) + else + zBottomMinusOffset = iFaceHeight(GV%ke+1) + min( max(CS%deepOBLoffset,0.0), -0.1*iFaceHeight(GV%ke+1)) + zBottomMinusOffset = min(zBottomMinusOffset, iFaceHeight(2)) ! no shallower than top layer + endif + + ! use these to check if all points are convered + CS%ERdepth(i,j) = 0.0 + CS%RNdepth(i,j) = 0.0 + + if (CS%fixedOBLdepth) then + CS%OBLdepth(i,j) = CS%fixedOBLdepth_value + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + else + ERdepth = 0.0 + if ( CS%StokesMOST .and. (surfBuoy_NS < 0.0) ) then + ! Search for Entrainment rule depth (ER_depth) + call CVMix_kpp_compute_ER_depth( & + z_inter, & ! (in) Interface heights <= 0 [m] + N2_1d*US%s_to_T**2, & ! (in) Column of Buoyancy Gradients at interfaces [s-2] + OBL_depth, & ! (in) Array of assumed OBL depths [m] + surfFricVel, & ! (in) surface friction velocity [m s-1] + surfBuoy_NS*buoy_scale, & ! (in) surface non-solar Buoyancy flux [m2 s-3] + surfBuoyFlux2, & ! (in) Buoyancy flux surface to OBL_depth [m2 s-3] + StokesXI_1d, & ! (in) Stokes similarity parameter given OBL_depth [nondim] + BEdE_ER_1d, & ! (in) Parameterized Entrainment Rule given OBL_depth [m3 s-3] + ERdepth, & ! (out) Entrainment Rule Boundary Layer Depth [m] + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + if ( ERdepth*US%m_to_Z > -iFaceHeight(2) ) then ! deeper than top layer + CS%OBLdepth(i,j) = max(US%m_to_Z * ERdepth, CS%minOBLdepth) ! min( ERdepth , -zBottomMinusOffset ) + CS%ERdepth(i,j) = 100. ! check and diagnostic for ER depth calculated + endif + endif + + ! Original Richardson Number method (always the case with CS%StokesMOST=False) + if (CS%ERdepth(i,j) == 0.) then + Vt_layer = 1.0 ! CS%surf_layer_ext + call CVMix_kpp_compute_turbulent_scales( & ! 1d_OBL Vt_layer, & ! (in) Boundary layer extent contributing to unresolved shear OBL_depth, & ! (in) OBL depth [m] surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - xi=StokesVt_1d, & ! (in) Stokes similarity parameter-->1/CHI(xi) enhance of Vt + xi=StokesXi_1d, & ! (in) Stokes similarity parameter-->1/CHI(xi) enhance of Vt w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] CVMix_kpp_params_user=CS%KPP_params ) - ! Determine the enhancement factor for unresolved shear - IF (CS%LT_VT2_ENHANCEMENT) then - IF (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then - LangEnhVT2 = CS%KPP_VT2_ENH_FAC - elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then - !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. - if (present(lamult)) then - LangEnhVT2 = lamult(i,j) + ! Determine the enhancement factor for unresolved shear + if (CS%LT_VT2_ENHANCEMENT) then + if (CS%LT_VT2_METHOD==LT_VT2_MODE_CONSTANT) then + LangEnhVT2 = CS%KPP_VT2_ENH_FAC + elseif (CS%LT_VT2_METHOD==LT_VT2_MODE_VR12) then + !Introduced minimum value for La_SL, so maximum value for enhvt2 is removed. + if (present(lamult)) then + LangEnhVT2 = lamult(i,j) + else + LangEnhVT2 = sqrt(1.+(1.5*CS%La_SL(i,j))**(-2) + & + (5.4*CS%La_SL(i,j))**(-4)) + endif + else + ! for other methods (e.g., LT_VT2_MODE_RW16, LT_VT2_MODE_LF17), the enhancement factor is + ! computed internally within CVMix using LaSL, bfsfc, and ustar to be passed to CVMix. + LangEnhVT2 = 1.0 + endif else - LangEnhVT2 = sqrt(1.+(1.5*CS%La_SL(i,j))**(-2) + & - (5.4*CS%La_SL(i,j))**(-4)) + LangEnhVT2 = 1.0 endif - else - ! for other methods (e.g., LT_VT2_MODE_RW16, LT_VT2_MODE_LF17), the enhancement factor is - ! computed internally within CVMix using LaSL, bfsfc, and ustar to be passed to CVMix. - LangEnhVT2 = 1.0 - endif - else - LangEnhVT2 = 1.0 - endif - - surfBuoyFlux = buoy_scale * buoyFlux(i,j,1) - ! Calculate Bulk Richardson number from eq (21) of LMD94 - BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & + ! Calculate Bulk Richardson number from eq (21) of LMD94 + BulkRi_1d = CVmix_kpp_compute_bulk_Richardson( & zt_cntr=z_cell, & ! Depth of cell center [m] delta_buoy_cntr=deltaBuoy, & ! Bulk buoyancy difference, Br-B(z) [m s-2] delta_Vsqr_cntr=deltaU2, & ! Square of resolved velocity difference [m2 s-2] @@ -1387,71 +1532,103 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl uStar=surfFricVel, & ! surface friction velocity [m s-1] CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters -! ! A hack to avoid KPP reaching the bottom. It was needed during development -! ! because KPP was unable to handle vanishingly small layers near the bottom. -! if (CS%deepOBLoffset>0.) then -! zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) -! CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) -! endif - zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset,-0.1*iFaceHeight(GV%ke+1)) - - call CVMix_kpp_compute_OBL_depth( & - BulkRi_1d, & ! (in) Bulk Richardson number - z_inter, & ! (in) Height of interfaces [m] - KPP_OBL_depth, & ! (out) OBL depth [m] - CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent - zt_cntr=z_cell, & ! (in) Height of cell centers [m] - surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - surf_buoy=surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] - Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] - Xi = StokesXI_1d, & ! (in) Stokes similarity parameter Lmob limit (1-Xi) - zBottom = zBottomMinusOffset, & ! (in) Numerical limit on OBLdepth - CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters - CS%OBLdepth(i,j) = US%m_to_Z * KPP_OBL_depth - - if (CS%StokesMOST) then + + call CVMix_kpp_compute_OBL_depth( & + BulkRi_1d, & ! (in) Bulk Richardson number + z_inter, & ! (in) Height of interfaces [m] + KPP_OBL_depth, & ! (out) OBL depth [m] + CS%kOBL(i,j), & ! (out) level (+fraction) of OBL extent + zt_cntr=z_cell, & ! (in) Height of cell centers [m] + surf_fric=surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + surf_buoy=surfBuoyFlux2, & ! (in) Buoyancy flux at surface [m2 s-3] + Coriolis=Coriolis, & ! (in) Coriolis parameter [s-1] + Xi = StokesXI_1d, & ! (in) Stokes similarity parameter Lmob limit (1-Xi) + zBottom = zBottomMinusOffset*US%Z_to_m, & ! (in) Numerical limit on OBLdepth + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + CS%OBLdepth(i,j) = US%m_to_Z * KPP_OBL_depth + if (.not.CS%OBL_depth_bounds_bug) & + CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer + CS%RNdepth(i,j) = 100. ! check and diagnostic + endif ! KPP_OBL_depth + + endif ! fixedOBLdepth + CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) ! no deeper than deepOBLoffset off bottom + CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) kbl = int(CS%kOBL(i,j)) - SLdepth_0d = CS%surf_layer_ext*CS%OBLdepth(i,j) - surfBuoyFlux = surfBuoyFlux2(kbl) + + if (CS%StokesMOST) then + ! Now we have OBLdepth and need to compute diagnostics + SLdepth_0d = CS%surf_layer_ext*CS%OBLdepth(i,j) + surfBuoyFlux = surfBuoyFlux2(kbl) ! find ksfc for cell where "surface layer" sits - ksfc = kbl - do ktmp = 1, kbl - if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then - ksfc = ktmp - exit + ksfc = kbl + do ktmp = 1, kbl + if (-1.0*iFaceHeight(ktmp+1) >= SLdepth_0d) then + ksfc = ktmp + exit + endif + enddo + + call Compute_StokesDrift(i,j, iFaceHeight(kbl), iFaceHeight(kbl+1), & + -CS%OBLdepth(i,j),iFaceHeight(ksfc),-SLdepth_0d, & + uS_Hi(kbl+1), vS_Hi(kbl+1), uS_H(kbl), vS_H(kbl), uS_SL, vS_SL, & + uSbar_H(kbl), vSbar_H(kbl), uSb_SL, vSb_SL, waves) + + call cvmix_kpp_compute_StokesXi( & + iFaceHeight*US%Z_to_m, & ! (in) Cell interface height [m] + CellHeight*US%Z_to_m, & ! (in) Cell center height [m] + ksfc, & ! (in) Cell index of Surface Layer Depth + SLdepth_0d*US%Z_to_m, & ! (in) Surface Layer Depth [m] + surfBuoyFlux, & ! (in) Surface buoyancy flux [m2 s-3] + surfBuoy_NS*buoy_scale, & ! (in) Non-solar surface buoyancy flux [m2 s-3] + surfFricVel, & ! (in) Surface wind forcing from x-axis [m s-1] + waves%omega_w2x(i,j), & ! (in) Wind direction ccw from model x- axis [nondim radians] + uE_H*US%L_T_to_m_s, & ! (in) Eulerian velocity at cell centers [m s-1] + vE_H*US%L_T_to_m_s, & ! (in) Eulerian velocity at cell centers [m s-1] + uS_Hi*US%L_T_to_m_s, & ! (in) Stokes drift at interfaces [m s-1] + vS_Hi*US%L_T_to_m_s, & ! (in) Stokes drift at interfaces [m s-1] + uSbar_H*US%L_T_to_m_s, & ! (in) Cell average Stokes drift [m s-1] + vSbar_H*US%L_T_to_m_s, & ! (in) Cell average Stokes drift [m s-1] + uS_SL*US%L_T_to_m_s, & ! (in) Stokes drift at SLDepth [m s-1] + vS_SL*US%L_T_to_m_s, & ! (in) Stokes drift at SLDepth [m s-1] + uSb_SL*US%L_T_to_m_s, & ! (in) Average Stokes drift cell top to SLDepth [m s-1] + vSb_SL*US%L_T_to_m_s, & ! (in) Average Stokes drift cell top to SLDepth [m s-1] + StokesXI, & ! (inout) Stokes XI similarity parameter [nondim] + BEdE_ER, & ! (inout) Entrainment rule product [m3 s-3] + PU_TKE, PS_TKE, PB_TKE, & ! (inout) Shear, Stokes, Buoyancy SL TKE Production [m3 s-3] + CVMix_kpp_params_user=CS%KPP_params ) ! KPP parameters + + ! The expression setting CS%Lam2 is slightly convoluted, but it avoids division by 0. + uS_Hi_mag = US%L_T_to_m_s * sqrt((US_Hi(1)**2) + (VS_Hi(1)**2)) + if (uS_Hi_mag >= surfFricVel*Lam2_max) then + CS%Lam2(i,j) = Lam2_max + else + CS%Lam2(i,j) = uS_Hi_mag / surfFricVel endif - enddo + CS%PU_TKE(i,j) = PU_TKE + CS%PS_TKE(i,j) = PS_TKE + CS%PB_TKE(i,j) = PB_TKE + CS%StokesXI(i,j) = StokesXI ! StokesXI_1d(kbl) - call Compute_StokesDrift(i,j, iFaceHeight(ksfc) , -SLdepth_0d, & - uS_SLD , vS_SLD, uS_SLC , vS_SLC, uSbar_SLD, vSbar_SLD, Waves) - call cvmix_kpp_compute_StokesXi( iFaceHeight,CellHeight,ksfc ,SLdepth_0d, & - surfBuoyFlux, surfFricVel,waves%omega_w2x(i,j), uE_H, vE_H, uS_Hi, & - vS_Hi, uSbar_H, vSbar_H, uS_SLD, vS_SLD, uSbar_SLD, vSbar_SLD, & - StokesXI, CVMix_kpp_params_user=CS%KPP_params ) - CS%StokesParXI(i,j) = StokesXI - CS%Lam2(i,j) = sqrt(US_Hi(1)**2+VS_Hi(1)**2) / MAX(surfFricVel,0.0002) - - else !.not Stokes_MOST - CS%StokesParXI(i,j) = 10.0 - CS%Lam2(i,j) = sqrt(US_Hi(1)**2+VS_Hi(1)**2) / MAX(surfFricVel,0.0002) - - ! A hack to avoid KPP reaching the bottom. It was needed during development - ! because KPP was unable to handle vanishingly small layers near the bottom. - if (CS%deepOBLoffset>0.) then - zBottomMinusOffset = iFaceHeight(GV%ke+1) + min(CS%deepOBLoffset, -0.1*iFaceHeight(GV%ke+1)) - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -zBottomMinusOffset ) endif - ! apply some constraints on OBLdepth - if (CS%fixedOBLdepth) CS%OBLdepth(i,j) = CS%fixedOBLdepth_value - CS%OBLdepth(i,j) = max( CS%OBLdepth(i,j), -iFaceHeight(2) ) ! no shallower than top layer - CS%OBLdepth(i,j) = min( CS%OBLdepth(i,j), -iFaceHeight(GV%ke+1) ) ! no deeper than bottom - CS%kOBL(i,j) = CVMix_kpp_compute_kOBL_depth( iFaceHeight, cellHeight, CS%OBLdepth(i,j) ) - - endif !Stokes_MOST - + ! recompute unresolved squared velocity, wscale and BulkRi for known boundary layer depth ! compute unresolved squared velocity for diagnostics - if (CS%id_Vt2 > 0) then + !BGR consider if LTEnhancement is wanted for diagnostics + if ( (CS%id_Ws > 0) .or. (CS%id_Vt2 > 0) .or. (CS%id_BulkRi > 0) ) then + call CVMix_kpp_compute_turbulent_scales( & + -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate [nondim] + US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] + surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] + surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] + xi=StokesXI, & ! (in) Stokes similarity parameter-->1/CHI(xi) enhance + w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] + CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters + if ( CS%id_Ws > 0 ) CS%Ws(i,j,:) = US%m_to_Z*US%T_to_s*Ws_1d(:) + endif + + if ( (CS%id_Vt2 > 0) .or. (CS%id_BulkRi > 0) ) then Vt2_1d(:) = CVmix_kpp_compute_unresolved_shear( & z_cell, & ! Depth of cell center [m] ws_cntr=Ws_1d, & ! Turbulent velocity scale profile, at centers [m s-1] @@ -1461,40 +1638,38 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl bfsfc=surfBuoyFlux2, & ! surface buoyancy flux [m2 s-3] uStar=surfFricVel, & ! surface friction velocity [m s-1] CVmix_kpp_params_user=CS%KPP_params ) ! KPP parameters - CS%Vt2(i,j,:) = US%m_to_Z**2*US%T_to_s**2 * Vt2_1d(:) + if (CS%id_Vt2 > 0) CS%Vt2(i,j,:) = US%m_to_Z**2 * US%T_to_s**2 * Vt2_1d(:) endif - - ! recompute wscale for diagnostics, now that we in fact know boundary layer depth - !BGR consider if LTEnhancement is wanted for diagnostics - if (CS%id_Ws > 0) then - call CVMix_kpp_compute_turbulent_scales( & - -cellHeight(:)/CS%OBLdepth(i,j), & ! (in) Normalized boundary layer coordinate [nondim] - US%Z_to_m*CS%OBLdepth(i,j), & ! (in) OBL depth [m] - surfBuoyFlux, & ! (in) Buoyancy flux at surface [m2 s-3] - surfFricVel, & ! (in) Turbulent friction velocity at surface [m s-1] - xi=StokesXI, & ! (in) Stokes similarity parameter-->1/CHI(xi) enhance - w_s=Ws_1d, & ! (out) Turbulent velocity scale profile [m s-1] - CVMix_kpp_params_user=CS%KPP_params) ! KPP parameters - CS%Ws(i,j,:) = US%m_to_Z*US%T_to_s*Ws_1d(:) + if (CS%id_BulkRi > 0) then + do k = 1, GV%ke + BulkRi_1d(k) = -z_cell(k) * deltaBuoy(kbl) / ( deltaU2(k) + Vt2_1d(k) ) + CS%BulkRi(i,j,k) = BulkRi_1d(k) + enddo endif - ! Diagnostics + ! Diagnostics if (CS%id_N2 > 0) CS%N2(i,j,:) = N2_1d(:) if (CS%id_BulkDrho > 0) CS%dRho(i,j,:) = deltaRho(:) - if (CS%id_BulkRi > 0) CS%BulkRi(i,j,:) = BulkRi_1d(:) if (CS%id_BulkUz2 > 0) CS%Uz2(i,j,:) = US%m_s_to_L_T**2 * deltaU2(:) if (CS%id_Tsurf > 0) CS%Tsurf(i,j) = surfTemp if (CS%id_Ssurf > 0) CS%Ssurf(i,j) = surfSalt if (CS%id_Usurf > 0) CS%Usurf(i,j) = surfU if (CS%id_Vsurf > 0) CS%Vsurf(i,j) = surfV + if (CS%id_BEdE_ER > 0) CS%BEdE_ER(i,j) = BEdE_ER endif ; enddo enddo call cpu_clock_end(id_clock_KPP_compute_BLD) + if (CS%debug .and. CS%StokesMOST) then + call hchksum(CS%PS_TKE, 'MOM_CVMix_KPP: PS_TKE', G%HI) + call hchksum(CS%PU_TKE, 'MOM_CVMix_KPP: PU_TKE', G%HI) + call hchksum(CS%PB_TKE, 'MOM_CVMix_KPP: PB_TKE', G%HI) + endif + ! send diagnostics to post_data - if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) + if (CS%id_BulkRi > 0) call post_data(CS%id_BulkRi, CS%BulkRi, CS%diag) if (CS%id_N > 0) call post_data(CS%id_N, CS%N, CS%diag) if (CS%id_N2 > 0) call post_data(CS%id_N2, CS%N2, CS%diag) if (CS%id_Tsurf > 0) call post_data(CS%id_Tsurf, CS%Tsurf, CS%diag) @@ -1509,8 +1684,14 @@ subroutine KPP_compute_BLD(CS, G, GV, US, h, Temp, Salt, u, v, tv, uStar, buoyFl if (CS%id_Vt2 > 0) call post_data(CS%id_Vt2, CS%Vt2, CS%diag) if (CS%StokesMOST) then - if (CS%id_StokesXI > 0) call post_data(CS%id_StokesXI, CS%StokesParXI, CS%diag) - if (CS%id_Lam2 > 0) call post_data(CS%id_Lam2 , CS%Lam2 , CS%diag) + if (CS%id_StokesXI > 0) call post_data(CS%id_StokesXI, CS%StokesXI, CS%diag) + if (CS%id_Lam2 > 0) call post_data(CS%id_Lam2 , CS%Lam2, CS%diag) + if (CS%id_BEdE_ER > 0) call post_data(CS%id_BEdE_ER, CS%BEdE_ER, CS%diag) + if (CS%id_ERdepth > 0) call post_data(CS%id_ERdepth, CS%ERdepth, CS%diag) + if (CS%id_RNdepth > 0) call post_data(CS%id_RNdepth, CS%RNdepth, CS%diag) + if (CS%id_PU_TKE > 0) call post_data(CS%id_PU_TKE, CS%PU_TKE, CS%diag) + if (CS%id_PS_TKE > 0) call post_data(CS%id_PS_TKE, CS%PS_TKE, CS%diag) + if (CS%id_PB_TKE > 0) call post_data(CS%id_PB_TKE, CS%PB_TKE, CS%diag) endif ! BLD smoothing: @@ -1555,7 +1736,7 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, dz) ! This code replicates the interface height calculations below. It could be simpler, as shown below. dh = dz(i,j,k) ! Nominal thickness to use for increment dh = dh + h_cor(i) ! Take away the accumulated error (could temporarily make dh<0) - h_cor(i) = min( dh - CS%min_thickness, 0. ) ! If inflating then hcorr<0 + h_cor(i) = min( dh - CS%min_thickness, 0. ) ! If inflating then h_cor<0 dh = max( dh, CS%min_thickness ) ! Limit increment dh>=min_thickness total_depth(i,j) = total_depth(i,j) + dh endif ; enddo @@ -1635,7 +1816,6 @@ subroutine KPP_smooth_BLD(CS, G, GV, US, dz) end subroutine KPP_smooth_BLD - !> Copies KPP surface boundary layer depth into BLD, in units of [Z ~> m] unless other units are specified. subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) type(KPP_CS), pointer :: CS !< Control structure for @@ -1658,6 +1838,24 @@ subroutine KPP_get_BLD(CS, BLD, G, US, m_to_BLD_units) end subroutine KPP_get_BLD +!> Copies CS%Lam2 into Lam2. +subroutine KPP_get_Lam2(CS, Lam2, G, US) + type(KPP_CS), pointer :: CS !< Control structure for + !! this module + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: Lam2 !< (Langmuir Number)^-2 [nondim] + + ! Local variables + integer :: i,j ! Horizontal indices + + !$OMP parallel do default(none) shared(Lam2, CS, G) + do j = G%jsc, G%jec ; do i = G%isc, G%iec + Lam2(i,j) = CS%Lam2(i,j) + enddo ; enddo + +end subroutine KPP_get_Lam2 + !> Apply KPP non-local transport of surface fluxes for a given tracer subroutine KPP_NonLocalTransport(CS, G, GV, h, nonLocalTrans, surfFlux, & dt, diag, tr_ptr, scalar, flux_scale) @@ -1765,47 +1963,75 @@ subroutine KPP_NonLocalTransport_saln(CS, G, GV, h, nonLocalTrans, surfFlux, dt, end subroutine KPP_NonLocalTransport_saln -!> Compute Stokes Drift components at zbot < ztop <= 0 and at k=0.5*(ztop+zbot) and -!! average components from ztop to zbot <= 0 -subroutine Compute_StokesDrift(i ,j, ztop, zbot, uS_i, vS_i, uS_k, vS_k, uSbar, vSbar, waves) - - type(wave_parameters_CS), pointer :: waves !< Wave CS for Langmuir turbulence - real, intent(in) :: ztop !< cell top - real, intent(in) :: zbot !< cell bottom - real, intent(inout) :: uS_i !< Stokes u velocity at zbot interface - real, intent(inout) :: vS_i !< Stokes v velocity at zbot interface - real, intent(inout) :: uS_k !< Stokes u velocity at zk center - real, intent(inout) :: vS_k !< Stokes v at zk =0.5(ztop+zbot) - real, intent(inout) :: uSbar !< mean Stokes u (ztop to zbot) - real, intent(inout) :: vSbar !< mean Stokes v (ztop to zbot) + +!> Compute Stokes Drift components and integrals needed to compute +!! Stokes TKE production parameters. +subroutine Compute_StokesDrift(i ,j, ztop, zbot, zBL, zSLtop, zSL, uS_i, vS_i, uS_k, vS_k, uS_SL, vS_SL, & + uSbar, vSbar, uSb_SL, vSb_SL, waves) + type(wave_parameters_CS), pointer :: waves !< Wave CS for Langmuir turbulence + real, intent(in) :: ztop !< boundary layer cellheight top (<0) [Z ~> m] + real, intent(in) :: zbot !< boundary layer cellheight bottom (<0) [Z ~> m] + real, intent(in) :: zBL !< boundary layer cellheight center (<0) [Z ~> m] + real, intent(in) :: zSLtop !< surface layer cell top [Z ~> m] + real, intent(in) :: zSL !< surface layer cell depth [Z ~> m] + real, intent(inout) :: uS_i !< Zonal Stokes velocity at zbot interface [L T-1 ~> m s-1] + real, intent(inout) :: vS_i !< Meridional Stokes velocity at zbot interface [L T-1 ~> m s-1] + real, intent(inout) :: uS_k !< Zonal Stokes velocity at zbl [L T-1 ~> m s-1] + real, intent(inout) :: vS_k !< Meridional Stokes velocity at zbl [L T-1 ~> m s-1] + real, intent(inout) :: uS_SL !< Zonal Stokes velocity at zSL [L T-1 ~> m s-1] + real, intent(inout) :: vS_SL !< Meridional Stokes velocity at zSL [L T-1 ~> m s-1] + real, intent(inout) :: uSbar !< Mean zonal Stokes velocity at ztop [L T-1 ~> m s-1] + real, intent(inout) :: vSbar !< Mean meridional Stokes velocity at zbot [L T-1 ~> m s-1] + real, intent(inout) :: uSb_SL !< Mean zonal Stokes velocity at zSLtop [L T-1 ~> m s-1] + real, intent(inout) :: vSb_SL !< Mean meridional Stokes velocity at zSL [L T-1 ~> m s-1] integer, intent(in) :: i !< Meridional index of H-point integer, intent(in) :: j !< Zonal index of H-point ! local variables integer :: b !< wavenumber band index - real :: fexp !< an exponential function - real :: WaveNum !< Wavenumber - - uS_i = 0.0 - vS_i = 0.0 - uS_k = 0.0 - vS_k = 0.0 - uSbar = 0.0 - vSbar = 0.0 + real :: fexp !< dummy exponential function [nondim] + real :: WaveNum !< Wavenumber [Z-1 ~> m-1] + + ! initialize variables + uS_i = 0.0 + vS_i = 0.0 + uS_k = 0.0 + vS_k = 0.0 + uS_SL = 0.0 + vS_SL = 0.0 + uSbar = 0.0 + vSbar = 0.0 + uSb_SL = 0.0 + vSb_SL = 0.0 + do b = 1, waves%NumBands WaveNum = waves%WaveNum_Cen(b) + fexp = exp(2. * WaveNum * zbot) uS_i = uS_i + waves%Ustk_Hb(i,j,b) * fexp vS_i = vS_i + waves%Vstk_Hb(i,j,b) * fexp - fexp = exp( WaveNum * (ztop + zbot) ) + + fexp = exp(2. * WaveNum * zBL ) uS_k = uS_k+ waves%Ustk_Hb(i,j,b) * fexp vS_k = vS_k+ waves%Vstk_Hb(i,j,b) * fexp - fexp = exp(2. * WaveNum * ztop) - exp(2. * WaveNum * zbot) + + fexp = exp(2. * WaveNum * zSL ) + uS_SL = uS_SL + waves%Ustk_Hb(i,j,b) * fexp + vS_SL = vS_SL + waves%Vstk_Hb(i,j,b) * fexp + + fexp = exp(2. * WaveNum * ztop) - exp(2. * WaveNum * zbot ) uSbar = uSbar + 0.5 * waves%Ustk_Hb(i,j,b) * fexp / WaveNum vSbar = vSbar + 0.5 * waves%Vstk_Hb(i,j,b) * fexp / WaveNum + + fexp = exp(2. * WaveNum * zSLtop) - exp(2. * WaveNum * zSL) + uSb_SL = uSb_SL + 0.5 * waves%Ustk_Hb(i,j,b) * fexp / WaveNum + vSb_SL = vSb_SL + 0.5 * waves%Vstk_Hb(i,j,b) * fexp / WaveNum + enddo - uSbar = uSbar / (ztop-zbot) - vSbar = vSbar / (ztop-zbot) + uSbar = uSbar / (ztop-zbot) + vSbar = vSbar / (ztop-zbot) + uSb_SL = uSb_SL / (zSLtop-zSL) + vSb_SL = vSb_SL / (zSLtop-zSL) end subroutine Compute_StokesDrift @@ -1816,7 +2042,6 @@ subroutine KPP_end(CS) if (.not.associated(CS)) return deallocate(CS) - end subroutine KPP_end end module MOM_CVMix_KPP diff --git a/src/parameterizations/vertical/MOM_CVMix_conv.F90 b/src/parameterizations/vertical/MOM_CVMix_conv.F90 index 3589c184df..759c470d39 100644 --- a/src/parameterizations/vertical/MOM_CVMix_conv.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_conv.F90 @@ -176,7 +176,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) integer :: kOBL !< level of ocean boundary layer extent real :: g_o_rho0 ! Gravitational acceleration, perhaps divided by density, times unit conversion factors ! [H s-2 R-1 ~> m4 s-2 kg-1 or m s-2] - real :: pref ! Interface pressures [R L2 T-2 ~> Pa] + real :: pRef ! Interface pressures [R L2 T-2 ~> Pa] real :: rhok, rhokm1 ! In situ densities of the layers above and below at the interface pressure [R ~> kg m-3] real :: dh_int ! The distance between layer centers [H ~> m or kg m-2] real :: dh, hcorr ! Limited thicknesses and a cumulative correction [Z ~> m] @@ -213,7 +213,7 @@ subroutine calculate_CVMix_conv(h, tv, G, GV, US, CS, hbl, Kd, Kv, Kd_aux) do K=2,GV%ke ! pRef is pressure at interface between k and km1 [R L2 T-2 ~> Pa]. - pRef = pRef + (GV%H_to_RZ*GV%g_Earth) * h(i,j,k) + pRef = pRef + (GV%H_to_RZ*GV%g_Earth) * h(i,j,k-1) call calculate_density(tv%t(i,j,k), tv%s(i,j,k), pRef, rhok, tv%eqn_of_state) call calculate_density(tv%t(i,j,k-1), tv%s(i,j,k-1), pRef, rhokm1, tv%eqn_of_state) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 1d43b95447..d4d9f031d9 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -37,6 +37,8 @@ module MOM_CVMix_shear integer :: n_smooth_ri !< Number of times to smooth Ri using a 1-2-1 filter real :: Ri_zero !< LMD94 critical Richardson number [nondim] real :: Nu_zero !< LMD94 maximum interior diffusivity [Z2 T-1 ~> m2 s-1] + real :: Prandtl !< The turbulent Prandtl number to be used in the + !! CVMIX shear mixing [nondim] real :: KPP_exp !< Exponent of unitless factor of diffusivities !! for KPP internal shear mixing scheme [nondim] real, allocatable, dimension(:,:,:) :: N2 !< Squared Brunt-Vaisala frequency [T-2 ~> s-2] @@ -291,6 +293,9 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) "NOTE this the internal mixing and this is "// & "not for setting the boundary layer depth.", & units="nondim", default=0.8) + call get_param(param_file, mdl, "PRANDTL_CVMIX_SHEAR", CS%Prandtl, & + "The turbulent Prandtl number to be used in the "// & + "CVMIX shear mixing.", units="nondim", default=1.0) call get_param(param_file, mdl, "KPP_EXP", CS%KPP_exp, & "Exponent of unitless factor of diffusivities, "// & "for KPP internal shear mixing scheme.", & @@ -302,7 +307,8 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) call cvmix_init_shear(mix_scheme=CS%Mix_Scheme, & KPP_nu_zero=US%Z2_T_to_m2_s*CS%Nu_Zero, & KPP_Ri_zero=CS%Ri_zero, & - KPP_exp=CS%KPP_exp) + KPP_exp=CS%KPP_exp, & + Prandtl_shear=CS%Prandtl) ! Register diagnostics; allocation and initialization CS%diag => diag diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 5389de3e1d..af1fa1a637 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -55,7 +55,7 @@ module MOM_diabatic_driver use MOM_internal_tides, only : internal_tides_init, internal_tides_end, int_tide_CS use MOM_kappa_shear, only : kappa_shear_is_used use MOM_CVMix_KPP, only : KPP_CS, KPP_init, KPP_compute_BLD, KPP_calculate -use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD, register_KPP_restarts +use MOM_CVMix_KPP, only : KPP_end, KPP_get_BLD, register_KPP_restarts, KPP_get_Lam2 use MOM_CVMix_KPP, only : KPP_NonLocalTransport_temp, KPP_NonLocalTransport_saln use MOM_oda_incupd, only : apply_oda_incupd, oda_incupd_CS use MOM_opacity, only : opacity_init, opacity_end, opacity_CS @@ -69,7 +69,7 @@ module MOM_diabatic_driver use MOM_sponge, only : apply_sponge, sponge_CS use MOM_ALE_sponge, only : apply_ALE_sponge, ALE_sponge_CS use MOM_time_manager, only : time_type, real_to_time, operator(-), operator(<=) -use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS +use MOM_tracer_flow_control, only : call_tracer_column_fns, tracer_flow_control_CS, extract_tracer_flow_member use MOM_tracer_diabatic, only : tracer_vertdiff, tracer_vertdiff_Eulerian use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs, vertvisc_type, accel_diag_ptrs @@ -188,6 +188,10 @@ module MOM_diabatic_driver logical :: Use_KdWork_diag = .false. !< Logical flag to indicate if any Kd_work diagnostics are on. logical :: Use_N2_diag = .false. !< Logical flag to indicate if any N2 diagnostics are on. + ! MARBL needs T & S from before the tracer_vertdiff call + real, allocatable, dimension(:,:,:) :: prediabatic_T !< Temperature prior to calling diabatic driver [C ~> degC] + real, allocatable, dimension(:,:,:) :: prediabatic_S !< Salinity prior to calling diabatic driver [S ~> ppt] + !>@{ Diagnostic IDs integer :: id_ea = -1, id_eb = -1 ! used by layer diabatic integer :: id_ea_t = -1, id_eb_t = -1, id_ea_s = -1, id_eb_s = -1 @@ -589,6 +593,7 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim real, dimension(SZI_(G),SZJ_(G)) :: & U_star, & ! The friction velocity [Z T-1 ~> m s-1]. + Lam2, & ! (Langmuir Number)^-2 [nondim] 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 @@ -649,6 +654,22 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim showCallTree = callTree_showQuery() if (showCallTree) call callTree_enter("diabatic_ALE_legacy(), MOM_diabatic_driver.F90") + ! Some tracer packages require T & S from the beginning of the diabatic step to + ! provide forcing consistent with the passive tracer values. The initialization + ! routine will allocate prediabatic_T and prediabatic_S if the tracer flow control + ! structure indicates it is necessary. If these arrays are allocated, they will store + ! a copy of tv%T & tv%S before this subroutine modifies the tv structure. + if (allocated(CS%prediabatic_T)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%prediabatic_T(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + if (allocated(CS%prediabatic_S)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%prediabatic_S(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averages(dt, Time_end, CS%diag) @@ -766,10 +787,14 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim endif call KPP_get_BLD(CS%KPP_CSp, BLD(:,:), G, US) + if (associated(visc%Lam2)) then + call KPP_get_Lam2(CS%KPP_CSp, Lam2(:,:), G, US) + endif ! 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 (associated(visc%Lam2)) visc%Lam2(:,:) = Lam2(:,:) if (.not.CS%KPPisPassive) then !$OMP parallel do default(shared) @@ -1042,8 +1067,8 @@ subroutine diabatic_ALE_legacy(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Tim ! Set diffusivities for VBF diagnostics if enabled if (CS%use_energetic_PBL .and. associated(CS%VBF%Kd_ePBL)) CS%VBF%Kd_ePBL(:,:,:) = Kd_ePBL(:,:,:) - if (associated(CS%VBF%Kd_salt)) CS%VBF%Kd_temp(:,:,:) = Kd_heat(:,:,:) - if (associated(CS%VBF%Kd_temp)) CS%VBF%Kd_salt(:,:,:) = Kd_salt(:,:,:) + if (associated(CS%VBF%Kd_temp)) CS%VBF%Kd_temp(:,:,:) = Kd_heat(:,:,:) + if (associated(CS%VBF%Kd_salt)) CS%VBF%Kd_salt(:,:,:) = Kd_salt(:,:,:) ! Diagnose the diapycnal diffusivities and other related quantities. @@ -1204,7 +1229,8 @@ 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, h_BL=visc%h_ML) + minimum_forcing_depth=CS%minimum_forcing_depth, h_BL=visc%h_ML, & + prediabatic_T=CS%prediabatic_T, prediabatic_S=CS%prediabatic_S) call cpu_clock_end(id_clock_tracers) @@ -1302,6 +1328,7 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, real, dimension(SZI_(G),SZJ_(G)) :: & U_star, & ! The friction velocity [Z T-1 ~> m s-1]. + Lam2, & ! (Langmuir Number)^-2 [nondim] 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 @@ -1365,6 +1392,22 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, if (.not. (CS%useALEalgorithm)) call MOM_error(FATAL, "MOM_diabatic_driver: "// & "The ALE algorithm must be enabled when using MOM_diabatic_driver.") + ! Some tracer packages require T & S from the beginning of the diabatic step to + ! provide forcing consistent with the passive tracer values. The initialization + ! routine will allocate prediabatic_T and prediabatic_S if the tracer flow control + ! structure indicates it is necessary. If these arrays are allocated, they will store + ! a copy of tv%T & tv%S before this subroutine modifies the tv structure. + if (allocated(CS%prediabatic_T)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%prediabatic_T(i,j,k) = tv%T(i,j,k) + enddo ; enddo ; enddo + endif + if (allocated(CS%prediabatic_S)) then + do k=1,nz ; do j=js,je ; do i=is,ie + CS%prediabatic_S(i,j,k) = tv%S(i,j,k) + enddo ; enddo ; enddo + endif + ! For all other diabatic subroutines, the averaging window should be the entire diabatic timestep call enable_averages(dt, Time_end, CS%diag) @@ -1482,11 +1525,16 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, Kd_salt, visc%Kv_shear, KPP_NLTheat, KPP_NLTscalar, Waves=Waves) endif + call KPP_get_BLD(CS%KPP_CSp, BLD(:,:), G, US) + if (associated(visc%Lam2)) then + call KPP_get_Lam2(CS%KPP_CSp, Lam2(:,:), G, US) + endif ! 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 (associated(visc%sfc_buoy_flx)) visc%sfc_buoy_flx(:,:) = KPP_buoy_flux(:,:,1) * US%L_to_Z**2 + if (associated(visc%Lam2)) visc%Lam2(:,:) = Lam2(:,:) if (showCallTree) call callTree_waypoint("done with KPP_calculate (diabatic)") if (CS%debug) then @@ -1686,8 +1734,8 @@ subroutine diabatic_ALE(u, v, h, tv, BLD, fluxes, visc, ADp, CDp, dt, Time_end, ! Set diffusivities for VBF diagnostics if enabled if (CS%use_energetic_PBL .and. associated(CS%VBF%Kd_ePBL)) CS%VBF%Kd_ePBL(:,:,:) = Kd_ePBL(:,:,:) - if (associated(CS%VBF%Kd_salt)) CS%VBF%Kd_temp(:,:,:) = Kd_heat(:,:,:) - if (associated(CS%VBF%Kd_temp)) CS%VBF%Kd_salt(:,:,:) = Kd_salt(:,:,:) + if (associated(CS%VBF%Kd_salt)) CS%VBF%Kd_salt(:,:,:) = Kd_salt(:,:,:) + if (associated(CS%VBF%Kd_temp)) CS%VBF%Kd_temp(:,:,:) = Kd_heat(:,:,:) ! Diagnose the diapycnal diffusivities and other related quantities. if (CS%id_Kd_heat > 0) call post_data(CS%id_Kd_heat, Kd_heat, CS%diag) @@ -1831,7 +1879,8 @@ 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, h_BL=visc%h_ML) + minimum_forcing_depth=CS%minimum_forcing_depth, h_BL=visc%h_ML, & + prediabatic_T=CS%prediabatic_T, prediabatic_S=CS%prediabatic_S) call cpu_clock_end(id_clock_tracers) @@ -3236,7 +3285,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! Local variables real :: Kd ! A diffusivity used in the default for other tracer diffusivities [Z2 T-1 ~> m2 s-1] - logical :: use_temperature + logical :: use_temperature, use_MARBL_tracers character(len=20) :: EN1, EN2, EN3 ! This "include" declares and sets the variable "version". @@ -3255,7 +3304,12 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di CS%diag => diag CS%Time => Time - if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp + if (associated(tracer_flow_CSp)) then + CS%tracer_flow_CSp => tracer_flow_CSp + call extract_tracer_flow_member(tracer_flow_CSp, use_MARBL_tracers=use_MARBL_tracers) + if (use_MARBL_tracers) & + allocate(CS%prediabatic_T(SZI_(G),SZJ_(G), SZK_(G)), CS%prediabatic_S(SZI_(G),SZJ_(G), SZK_(G))) + end if if (associated(sponge_CSp)) CS%sponge_CSp => sponge_CSp if (associated(ALE_sponge_CSp)) CS%ALE_sponge_CSp => ALE_sponge_CSp if (associated(oda_incupd_CSp)) CS%oda_incupd_CSp => oda_incupd_CSp @@ -3877,6 +3931,9 @@ subroutine diabatic_driver_end(CS) deallocate(CS%optics) endif + if (allocated(CS%prediabatic_T)) deallocate(CS%prediabatic_T) + if (allocated(CS%prediabatic_S)) deallocate(CS%prediabatic_S) + if (CS%debug_energy_req) & call diapyc_energy_req_end(CS%diapyc_en_rec_CSp) diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 0c72f83b0c..2bfada3bf1 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2714,7 +2714,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, use_ideal_age - logical :: do_brine_plume, use_hor_bnd_diff, use_neutral_diffusion, use_fpmix + logical :: do_brine_plume, use_hor_bnd_diff, use_neutral_diffusion, use_fpmix, use_StokesMOST 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. @@ -2797,6 +2797,10 @@ 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 openParameterBlock(param_file, 'KPP', do_not_log=.true.) + call get_param(param_file, mdl, 'STOKES_MOST', use_StokesMOST, & + default=.false., do_not_log=.true.) + call closeParameterBlock(param_file) call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", use_ideal_age, & default=.false., do_not_log=.true.) call openParameterBlock(param_file, 'MLE', do_not_log=.true.) @@ -2807,17 +2811,24 @@ subroutine set_visc_register_restarts(HI, G, GV, US, param_file, visc, restart_C if (MLE_use_PBL_MLD .or. MLE_use_Bodner) then call safe_alloc_ptr(visc%MLD, isd, ied, jsd, jed) endif + if (use_StokesMOST .and. MLE_use_Bodner) then + call safe_alloc_ptr(visc%Lam2, 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 .or. use_ideal_age) then call safe_alloc_ptr(visc%h_ML, isd, ied, jsd, jed) endif - if (MLE_use_PBL_MLD) then + if (MLE_use_PBL_MLD .or. MLE_use_Bodner) 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 (use_StokesMOST .and. MLE_use_Bodner) then + call register_restart_field(visc%Lam2, "Lam2", .false., restart_CS, & + "(Langmuir Number)^-2", units="" ) + endif if (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. MLE_use_Bodner) 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) diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 3c324c4147..9eba7e3471 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -225,8 +225,8 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G ! local variables real, dimension(SZIB_(G),SZJ_(G)) :: hbl_u !< boundary layer depth (u-pts) [H ~> m] real, dimension(SZI_(G),SZJB_(G)) :: hbl_v !< boundary layer depth (v-pts) [H ~> m] - real, dimension(SZIB_(G),SZJ_(G)) :: taux_u !< kinematic zonal wind stress (u-pts) [L2 T-2 ~> m2 s-2] - real, dimension(SZI_(G),SZJB_(G)) :: tauy_v !< kinematic merid wind stress (v-pts) [L2 T-2 ~> m2 s-2] + real, dimension(SZIB_(G),SZJ_(G)) :: taux_u !< kinematic zonal wind stress (u-pts) [L Z T-2 ~> m2 s-2] + real, dimension(SZI_(G),SZJB_(G)) :: tauy_v !< kinematic merid wind stress (v-pts) [L Z T-2 ~> m2 s-2] real, dimension(SZI_(G),SZJ_(G)) :: uS0 !< surface zonal Stokes drift h-pts [L T-1 ~> m s-1] real, dimension(SZI_(G),SZJ_(G)) :: vS0 !< surface zonal Stokes drift h-pts [L T-1 ~> m s-1] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: uE_u !< zonal Eulerian u-pts [L T-1 ~> m s-1] @@ -242,7 +242,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G real, dimension(SZI_(G) ,SZJ_(G),SZK_(GV)+1) :: omega_tau2s !< angle stress to shear (h-pts) [rad] real, dimension(SZI_(G) ,SZJ_(G),SZK_(GV)+1) :: omega_tau2w !< angle stress to wind (h-pts) [rad] real :: omega_tmp, omega_s2x, omega_tau2x !< temporary angle wrt the x axis [rad] - real :: Irho0 !< Inverse of the mean density rescaled to [Z L-1 R-1 ~> m3 kg-1] + real :: Irho0 !< Inverse of the mean density [R-1 ~> m3 kg-1] real :: pi !< ! The ratio of the circumference of a circle to its diameter [nondim] real :: tmp_u, tmp_v !< temporary ocean mask weights on u and v points [nondim] real :: fexp !< temporary exponential function [nondim] @@ -259,6 +259,13 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G pi = 4. * atan2(1.,1.) Irho0 = 1.0 / GV%Rho0 + ! initialize arrays + uE_h(:,:,:) = 0.0 + vE_h(:,:,:) = 0.0 + uE_u(:,:,:) = 0.0 + vE_v(:,:,:) = 0.0 + vInc_v(:,:,:) = 0.0 + uInc_u(:,:,:) = 0.0 call pass_var(hbl_h , G%Domain, halo=1) ! u-points @@ -281,7 +288,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G depth = depth + 0.5*CS%h_u(I,j,k) call cvmix_kpp_composite_Gshape(sigma,Gat1,Gsig,dGdsig) ! nonlocal boundary-layer increment - uInc_u(I,j,k) = dt * Cemp_NL * taux_u(I,j) * dGdsig / hbl_u(I,j) + uInc_u(I,j,k) = dt * Cemp_NL * taux_u(I,j) * dGdsig / (hbl_u(I,j) * GV%H_to_Z) ui(I,j,k) = ui(I,j,k) + uInc_u(I,j,k) else uInc_u(I,j,k) = 0.0 @@ -315,7 +322,7 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G depth = depth + 0.5* CS%h_v(i,J,k) call cvmix_kpp_composite_Gshape(sigma,Gat1,Gsig,dGdsig) ! nonlocal boundary-layer increment - vInc_v(i,J,k) = dt * Cemp_NL * tauy_v(i,J) * dGdsig / hbl_v(i,J) + vInc_v(i,J,k) = dt * Cemp_NL * tauy_v(i,J) * dGdsig / (hbl_v(i,J) * GV%H_to_Z) vi(i,J,k) = vi(i,J,k) + vInc_v(i,J,k) else vInc_v(i,J,k) = 0.0 @@ -352,20 +359,20 @@ subroutine vertFPmix(ui, vi, uold, vold, hbl_h, h, forces, dt, lpost, Cemp_NL, G vInc_h(i,j,k) = (G%mask2dCv(i,j) * vInc_v(i,j,k) + G%mask2dCv(i,j-1) * vInc_v(i,j-1,k)) / tmp_v enddo ! Wind, Stress and Shear align at surface - Omega_tau2w(i,j,1) = 0.0 - Omega_tau2s(i,j,1) = 0.0 + Omega_tau2w(i,j,:) = 0.0 + Omega_tau2s(i,j,:) = 0.0 do k = 1,nz kp1 = min( nz , k+1) du = uE_h(i,j,k) - uE_h(i,j,kp1) dv = vE_h(i,j,k) - vE_h(i,j,kp1) - omega_s2x = atan2( dv , du ) + omega_s2x = atan2(dv, du) du = du + uInc_h(i,j,k) - uInc_h(i,j,kp1) dv = dv + vInc_h(i,j,k) - vInc_h(i,j,kp1) - omega_tau2x = atan2( dv , du ) - + omega_tau2x = atan2(dv, du) omega_tmp = omega_tau2x - forces%omega_w2x(i,j) - if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi + + if ( (omega_tmp > pi ) ) omega_tmp = omega_tmp - 2.*pi if ( (omega_tmp < (0.-pi)) ) omega_tmp = omega_tmp + 2.*pi Omega_tau2w(i,j,kp1) = omega_tmp diff --git a/src/tracer/MARBL_forcing_mod.F90 b/src/tracer/MARBL_forcing_mod.F90 index 4713f91d44..1c80c5787f 100644 --- a/src/tracer/MARBL_forcing_mod.F90 +++ b/src/tracer/MARBL_forcing_mod.F90 @@ -10,7 +10,7 @@ module MARBL_forcing_mod !! for passing forcing fields to MARBL !! (This comment can go in the wiki on the NCAR fork?) -use MOM_diag_mediator, only : safe_alloc_ptr, diag_ctrl, register_diag_field, post_data +use MOM_diag_mediator, only : safe_alloc_ptr, diag_ctrl use MOM_time_manager, only : time_type use MOM_error_handler, only : MOM_error, WARNING, FATAL use MOM_file_parser, only : get_param, log_param, param_file_type @@ -28,28 +28,15 @@ module MARBL_forcing_mod public :: MARBL_forcing_init public :: convert_driver_fields_to_forcings -!> Data type used to store diagnostic index returned from register_diag_field() -!! For the forcing fields that can be written via post_data() -type, private :: marbl_forcing_diag_ids - integer :: atm_fine_dust !< Atmospheric fine dust component of dust_flux - integer :: atm_coarse_dust !< Atmospheric coarse dust component of dust_flux - integer :: atm_bc !< Atmospheric black carbon component of iron_flux - integer :: ice_dust !< Sea-ice dust component of dust_flux - integer :: ice_bc !< Sea-ice black carbon component of iron_flux -end type marbl_forcing_diag_ids - !> Control structure for this module type, public :: marbl_forcing_CS ; private type(diag_ctrl), pointer :: diag => NULL() !< A structure that is used to !! regulate the timing of diagnostic output. real :: dust_ratio_thres !< coarse/fine dust ratio threshold [1] - real :: dust_ratio_to_fe_bioavail_frac !< ratio of dust to iron bioavailability fraction [1] real :: fe_bioavail_frac_offset !< offset for iron bioavailability fraction [1] real :: atm_fe_to_bc_ratio !< atmospheric iron to black carbon ratio [1] - real :: atm_bc_fe_bioavail_frac !< atmospheric black carbon to iron bioavailablity fraction ratio [1] real :: seaice_fe_to_bc_ratio !< sea-ice iron to black carbon ratio [1] - real :: seaice_bc_fe_bioavail_frac !< sea-ice black carbon to iron bioavailablity fraction ratio [1] real :: iron_frac_in_atm_fine_dust !< Fraction of fine dust from the atmosphere that is iron [1] real :: iron_frac_in_atm_coarse_dust !< Fraction of coarse dust from the atmosphere that is iron [1] real :: iron_frac_in_seaice_dust !< Fraction of dust from the sea ice that is iron [1] @@ -57,9 +44,7 @@ module MARBL_forcing_mod real :: atm_alt_co2_const !< alternate atmospheric CO2 for _ALT_CO2 tracers !! (if specifying a constant value) [ppm] - type(marbl_forcing_diag_ids) :: diag_ids !< used for registering and posting some MARBL forcing fields as diagnostics - - logical :: use_marbl_tracers !< most functions can return immediately + logical :: use_MARBL_tracers !< most functions can return immediately !! MARBL tracers are turned off integer :: atm_co2_iopt !< Integer version of atm_co2_opt, which determines source of atm_co2 integer :: atm_alt_co2_iopt !< Integer version of atm_alt_co2_opt, which determines source of atm_alt_co2 @@ -73,14 +58,14 @@ module MARBL_forcing_mod contains - subroutine MARBL_forcing_init(G, US, param_file, diag, day, inputdir, use_marbl, CS) + subroutine MARBL_forcing_init(G, US, param_file, diag, day, inputdir, use_MARBL_tracers, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(diag_ctrl), target, intent(in) :: diag !< Structure used to regulate diagnostic output. type(time_type), target, intent(in) :: day !< Time of the start of the run. character(len=*), intent(in) :: inputdir !< Directory containing input files - logical, intent(in) :: use_marbl !< Is MARBL tracer package active? + logical, intent(in) :: use_MARBL_tracers !< Is MARBL tracer package active? type(marbl_forcing_CS), pointer, intent(inout) :: CS !< A pointer that is set to point to control !! structure for MARBL forcing @@ -96,26 +81,18 @@ subroutine MARBL_forcing_init(G, US, param_file, diag, day, inputdir, use_marbl, allocate(CS) CS%diag => diag - CS%use_marbl_tracers = .true. - if (.not. use_marbl) then - CS%use_marbl_tracers = .false. + CS%use_MARBL_tracers = .true. + if (.not. use_MARBL_tracers) then + CS%use_MARBL_tracers = .false. return endif call get_param(param_file, mdl, "DUST_RATIO_THRES", CS%dust_ratio_thres, & - "coarse/fine dust ratio threshold", units="1", default=69.00594) - call get_param(param_file, mdl, "DUST_RATIO_TO_FE_BIOAVAIL_FRAC", CS%dust_ratio_to_fe_bioavail_frac, & - "ratio of dust to iron bioavailability fraction", units="1", default=1./366.314) - call get_param(param_file, mdl, "FE_BIOAVAIL_FRAC_OFFSET", CS%fe_bioavail_frac_offset, & - "offset for iron bioavailability fraction", units="1", default=0.0146756) + "coarse/fine dust ratio threshold", units="1", default=90.) call get_param(param_file, mdl, "ATM_FE_TO_BC_RATIO", CS%atm_fe_to_bc_ratio, & - "atmospheric iron to black carbon ratio", units="1", default=1.) - call get_param(param_file, mdl, "ATM_BC_FE_BIOAVAIL_FRAC", CS%atm_bc_fe_bioavail_frac, & - "atmospheric black carbon to iron bioavailablity fraction ratio", units="1", default=0.06) + "atmospheric iron to black carbon ratio", units="1", default=1.33) call get_param(param_file, mdl, "SEAICE_FE_TO_BC_RATIO", CS%seaice_fe_to_bc_ratio, & - "sea-ice iron to black carbon ratio", units="1", default=1.) - call get_param(param_file, mdl, "SEAICE_BC_FE_BIOAVAIL_FRAC", CS%seaice_bc_fe_bioavail_frac, & - "sea-ice black carbon to iron bioavailablity fraction ratio", units="1", default=0.06) + "sea-ice iron to black carbon ratio", units="1", default=1.33) call get_param(param_file, mdl, "IRON_FRAC_IN_ATM_FINE_DUST", CS%iron_frac_in_atm_fine_dust, & "Fraction of fine dust from the atmosphere that is iron", units="1", default=0.035) call get_param(param_file, mdl, "IRON_FRAC_IN_ATM_COARSE_DUST", CS%iron_frac_in_atm_coarse_dust, & @@ -161,26 +138,6 @@ subroutine MARBL_forcing_init(G, US, param_file, diag, day, inputdir, use_marbl, default=284.317, units="ppm") endif - ! Register diagnostic fields for outputing forcing values - ! These fields are posted from convert_driver_fields_to_forcings(), and they are received - ! in physical units so no conversion is necessary here. - CS%diag_ids%atm_fine_dust = register_diag_field("ocean_model", "ATM_FINE_DUST_FLUX_CPL", & - CS%diag%axesT1, & ! T=> tracer grid? 1 => no vertical grid - day, "ATM_FINE_DUST_FLUX from cpl", "kg/m^2/s") - CS%diag_ids%atm_coarse_dust = register_diag_field("ocean_model", "ATM_COARSE_DUST_FLUX_CPL", & - CS%diag%axesT1, & ! T=> tracer grid? 1 => no vertical grid - day, "ATM_COARSE_DUST_FLUX from cpl", "kg/m^2/s") - CS%diag_ids%atm_bc = register_diag_field("ocean_model", "ATM_BLACK_CARBON_FLUX_CPL", & - CS%diag%axesT1, & ! T=> tracer grid? 1 => no vertical grid - day, "ATM_BLACK_CARBON_FLUX from cpl", "kg/m^2/s") - - CS%diag_ids%ice_dust = register_diag_field("ocean_model", "SEAICE_DUST_FLUX_CPL", & - CS%diag%axesT1, & ! T=> tracer grid? 1 => no vertical grid - day, "SEAICE_DUST_FLUX from cpl", "kg/m^2/s") - CS%diag_ids%ice_bc = register_diag_field("ocean_model", "SEAICE_BLACK_CARBON_FLUX_CPL", & - CS%diag%axesT1, & ! T=> tracer grid? 1 => no vertical grid - day, "SEAICE_BLACK_CARBON_FLUX from cpl", "kg/m^2/s") - end subroutine MARBL_forcing_init ! Note: ice fraction and u10_sqr are handled in mom_surface_forcing because of CFCs @@ -199,13 +156,13 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust !! [kg m-2 s-1] real, dimension(:,:), pointer, intent(in) :: seaice_bc_flux !< sea ice black carbon flux from IOB !! [kg m-2 s-1] - real, dimension(:,:), pointer, intent(in) :: afracr !< open ocean fraction [1] real, dimension(:,:), pointer, intent(in) :: nhx_dep !< NHx flux from atmosphere [kg m-2 s-1] real, dimension(:,:), pointer, intent(in) :: noy_dep !< NOy flux from atmosphere [kg m-2 s-1] real, dimension(:,:), pointer, intent(in) :: atm_co2_prog !< Prognostic atmospheric CO2 concentration !! [ppm] real, dimension(:,:), pointer, intent(in) :: atm_co2_diag !< Diagnostic atmospheric CO2 concentration !! [ppm] + real, dimension(:,:), pointer, intent(in) :: afracr !< open ocean fraction [1] real, dimension(:,:), pointer, intent(in) :: swnet_afracr !< shortwave flux * open ocean fraction !! [W m-2] real, dimension(:,:,:), pointer, intent(in) :: ifrac_n !< per-category ice fraction [1] @@ -225,6 +182,7 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust integer :: i, j, is, ie, js, je, m real :: atm_fe_bioavail_frac !< Fraction of iron from the atmosphere available for biological uptake [1] + real :: dust_ratio !< Ratio of coarse to fine dust from the atmosphere [1] real :: seaice_fe_bioavail_frac !< Fraction of iron from sea ice available for biological uptake [1] ! Note: following two conversion factors are used to both convert from km m-2 s-1 -> mmol m-2 s-1 !! AND cast in MOM6's unique dimensional consistency scaling system [conc Z T-1] @@ -233,31 +191,22 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust real :: ndep_conversion !< Factor to convert nitrogen deposition from kg m-2 s-1 -> mmol m-3 (m s-1) !! [s m2 kg-1 conc Z T-1 ~> mmol kg-1] - if (.not. CS%use_marbl_tracers) return + if (.not. CS%use_MARBL_tracers) return is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ndep_conversion = (1.e6/14.) * (US%m_to_Z * US%T_to_s) iron_flux_conversion = (1.e6 / molw_Fe) * (US%m_to_Z * US%T_to_s) - ! Post fields from coupler to diagnostics - ! TODO: units from diag register are incorrect; we should be converting these in the cap, I think - if (CS%diag_ids%atm_fine_dust > 0) & - call post_data(CS%diag_ids%atm_fine_dust, atm_fine_dust_flux(is-i0:ie-i0,js-j0:je-j0), & - CS%diag, mask=G%mask2dT(is:ie,js:je)) - if (CS%diag_ids%atm_coarse_dust > 0) & - call post_data(CS%diag_ids%atm_coarse_dust, atm_coarse_dust_flux(is-i0:ie-i0,js-j0:je-j0), & - CS%diag, mask=G%mask2dT(is:ie,js:je)) - if (CS%diag_ids%atm_bc > 0) & - call post_data(CS%diag_ids%atm_bc, atm_bc_flux(is-i0:ie-i0,js-j0:je-j0), CS%diag, & - mask=G%mask2dT(is:ie,js:je)) - if (CS%diag_ids%ice_dust > 0) & - call post_data(CS%diag_ids%ice_dust, seaice_dust_flux(is-i0:ie-i0,js-j0:je-j0), CS%diag, & - mask=G%mask2dT(is:ie,js:je)) - if (CS%diag_ids%ice_bc > 0) & - call post_data(CS%diag_ids%ice_bc, seaice_bc_flux(is-i0:ie-i0,js-j0:je-j0), CS%diag, & - mask=G%mask2dT(is:ie,js:je)) - do j=js,je ; do i=is,ie + ! Components of dust flux + fluxes%atm_fine_dust_flux(i,j) = (G%mask2dT(i,j) * US%kg_m2s_to_RZ_T) * atm_fine_dust_flux(i-i0,j-j0) + fluxes%atm_coarse_dust_flux(i,j) = (G%mask2dT(i,j) * US%kg_m2s_to_RZ_T) * atm_coarse_dust_flux(i-i0,j-j0) + fluxes%seaice_dust_flux(i,j) = (G%mask2dT(i,j) * US%kg_m2s_to_RZ_T) * seaice_dust_flux(i-i0,j-j0) + + ! Components of black carbon flux + fluxes%atm_bc_flux(i,j) = (G%mask2dT(i,j) * US%kg_m2s_to_RZ_T) * atm_bc_flux(i-i0,j-j0) + fluxes%seaice_bc_flux(i,j) = (G%mask2dT(i,j) * US%kg_m2s_to_RZ_T) * seaice_bc_flux(i-i0,j-j0) + ! Nitrogen Deposition fluxes%nhx_dep(i,j) = (G%mask2dT(i,j) * ndep_conversion) * nhx_dep(i-i0,j-j0) fluxes%noy_dep(i,j) = (G%mask2dT(i,j) * ndep_conversion) * noy_dep(i-i0,j-j0) @@ -328,13 +277,15 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust do j=js,je ; do i=is,ie ! TODO: abort if atm_fine_dust_flux and atm_coarse_dust_flux are not associated? ! Contribution of atmospheric dust to iron flux - if (atm_coarse_dust_flux(i-i0,j-j0) < & - CS%dust_ratio_thres * atm_fine_dust_flux(i-i0,j-j0)) then - atm_fe_bioavail_frac = CS%fe_bioavail_frac_offset + CS%dust_ratio_to_fe_bioavail_frac * & - (CS%dust_ratio_thres - atm_coarse_dust_flux(i-i0,j-j0) / atm_fine_dust_flux(i-i0,j-j0)) + atm_fe_bioavail_frac = 0.005 + if ((atm_coarse_dust_flux(i-i0,j-j0) > 0.) .and. (atm_fine_dust_flux(i-i0,j-j0)) > 0.) then + dust_ratio = max(atm_coarse_dust_flux(i-i0,j-j0) / atm_fine_dust_flux(i-i0,j-j0), 9.903) else - atm_fe_bioavail_frac = CS%fe_bioavail_frac_offset + dust_ratio = 9.903 endif + dust_ratio = dust_ratio - 5.5 + if (dust_ratio < CS%dust_ratio_thres) & + atm_fe_bioavail_frac = dust_ratio**(-0.9) - 0.0134 ! Contribution of atmospheric dust to iron flux fluxes%iron_flux(i,j) = (atm_fe_bioavail_frac * & @@ -342,8 +293,8 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust CS%iron_frac_in_atm_coarse_dust * atm_coarse_dust_flux(i-i0,j-j0))) ! Contribution of atmospheric black carbon to iron flux - fluxes%iron_flux(i,j) = fluxes%iron_flux(i,j) + (CS%atm_bc_fe_bioavail_frac * & - (CS%atm_fe_to_bc_ratio * atm_bc_flux(i-i0,j-j0))) + fluxes%iron_flux(i,j) = fluxes%iron_flux(i,j) + (atm_bc_flux(i-i0,j-j0) * & + (atm_fe_bioavail_frac * CS%atm_fe_to_bc_ratio)) seaice_fe_bioavail_frac = atm_fe_bioavail_frac ! Contribution of seaice dust to iron flux @@ -351,8 +302,8 @@ subroutine convert_driver_fields_to_forcings(atm_fine_dust_flux, atm_coarse_dust (CS%iron_frac_in_seaice_dust * seaice_dust_flux(i-i0,j-j0))) ! Contribution of seaice black carbon to iron flux - fluxes%iron_flux(i,j) = fluxes%iron_flux(i,j) + (CS%seaice_bc_fe_bioavail_frac * & - (CS%seaice_fe_to_bc_ratio * seaice_bc_flux(i-i0,j-j0))) + fluxes%iron_flux(i,j) = fluxes%iron_flux(i,j) + (seaice_bc_flux(i-i0,j-j0) * & + (seaice_fe_bioavail_frac * CS%seaice_fe_to_bc_ratio)) ! Unit conversion (kg m-2 s-1 -> conc Z T-1) fluxes%iron_flux(i,j) = (G%mask2dT(i,j) * iron_flux_conversion) * fluxes%iron_flux(i,j) diff --git a/src/tracer/MARBL_tracers.F90 b/src/tracer/MARBL_tracers.F90 index 20a600d171..a7bd64999e 100644 --- a/src/tracer/MARBL_tracers.F90 +++ b/src/tracer/MARBL_tracers.F90 @@ -36,7 +36,7 @@ module MARBL_tracers use MOM_tracer_initialization_from_Z, only : MOM_initialize_tracer_from_Z use MOM_tracer_Z_init, only : read_Z_edges 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 use MOM_diag_mediator, only : register_diag_field, post_data!, safe_alloc_ptr @@ -137,8 +137,9 @@ module MARBL_tracers type(vardesc), allocatable :: tr_desc(:) !< Descriptions and metadata for the tracers logical :: tracers_may_reinit !< If true the tracers may be initialized if not found in a restart file - character(len=200) :: fesedflux_file !< name of [netCDF] file containing iron sediment flux - character(len=200) :: feventflux_file !< name of [netCDF] file containing iron vent flux + character(len=200) :: fesedflux_file !< name of [netCDF] file containing iron sediment flux + character(len=200) :: fesedfluxred_file !< name of [netCDF] file containing reduced iron sediment flux + character(len=200) :: feventflux_file !< name of [netCDF] file containing iron vent flux type(forcing_timeseries_dataset) :: d14c_dataset(3) !< File and time axis information for d14c forcing real, dimension(3) :: d14c_bands !< forcing is organized into bands: [30 N, 90 N]; [30 S, 30 N]; [90 S, 30 S] !! This variable contains D14C for each band [CU ~> conc] @@ -261,7 +262,9 @@ module MARBL_tracers integer :: potemp_ind !< index of MARBL forcing field array to copy potential temperature into integer :: salinity_ind !< index of MARBL forcing field array to copy salinity into integer :: pressure_ind !< index of MARBL forcing field array to copy pressure into - integer :: fesedflux_ind !< index of MARBL forcing field array to copy iron sediment flux into + integer :: fesedflux_ind !< index of MARBL forcing field array to copy iron sediment flux into + integer :: fesedfluxred_ind !< index of MARBL forcing field array to copy reduced iron sediment flux into + integer :: feventflux_ind !< index of MARBL forcing field array to copy iron vent flux into integer :: o2_scalef_ind !< index of MARBL forcing field array to copy O2 scale length into integer :: remin_scalef_ind !< index of MARBL forcing field array to copy remin scale length into type(external_field), allocatable :: id_tracer_restoring(:) !< id number for time_interp_external @@ -290,8 +293,9 @@ module MARBL_tracers ! TODO: create generic 3D forcing input type to read z coordinate + values real :: fesedflux_scale_factor !< scale factor for iron sediment flux [mmol umol-1 d s-1] integer :: fesedflux_nz !< number of levels in iron sediment flux file - real, allocatable, dimension(:,:,:) :: fesedflux_in !< Field to read iron sediment flux into [conc m s-1] - real, allocatable, dimension(:,:,:) :: feventflux_in !< Field to read iron vent flux into [conc m s-1] + real, allocatable, dimension(:,:,:) :: fesedflux_in !< Field to read iron sediment flux into [conc m s-1] + real, allocatable, dimension(:,:,:) :: fesedfluxred_in !< Field to read reduced iron sediment flux into [conc m s-1] + real, allocatable, dimension(:,:,:) :: feventflux_in !< Field to read iron vent flux into [conc m s-1] real, allocatable, dimension(:) :: & fesedflux_z_edges !< The depths of the cell interfaces in the input data [Z ~> m] ! TODO: this thickness does not need to be 3D, but it is easier to make thickness 0 @@ -500,6 +504,8 @@ subroutine configure_MARBL_tracers(GV, US, param_file, CS) CS%salinity_ind = -1 CS%pressure_ind = -1 CS%fesedflux_ind = -1 + CS%fesedfluxred_ind = -1 + CS%feventflux_ind = -1 CS%o2_scalef_ind = -1 CS%remin_scalef_ind = -1 CS%d14c_ind = -1 @@ -526,6 +532,10 @@ subroutine configure_MARBL_tracers(GV, US, param_file, CS) CS%pressure_ind = m case('Iron Sediment Flux') CS%fesedflux_ind = m + case('Iron Red Sediment Flux') + CS%fesedfluxred_ind = m + case('Iron Vent Flux') + CS%feventflux_ind = m case('O2 Consumption Scale Factor') CS%o2_scalef_ind = m case('Particulate Remin Scale Factor') @@ -631,16 +641,25 @@ function register_MARBL_tracers(HI, GV, US, param_file, CS, tr_Reg, restart_CS, ! ** FESEDFLUX call get_param(param_file, mdl, "MARBL_FESEDFLUX_FILE", CS%fesedflux_file, & "The file in which the iron sediment flux forcing field can be found.", & - default="fesedflux_total_reduce_oxic_tx0.66v1.c230817.nc") + default="fesedflux.nc") if (scan(CS%fesedflux_file,'/') == 0) then ! Add the directory if CS%fesedflux_file is not already a complete path. CS%fesedflux_file = trim(slasher(inputdir))//trim(CS%fesedflux_file) call log_param(param_file, mdl, "INPUTDIR/MARBL_TRACERS_FESEDFLUX_FILE", CS%fesedflux_file) endif + ! ** FESEDFLUXRED + call get_param(param_file, mdl, "MARBL_FESEDFLUXRED_FILE", CS%fesedfluxred_file, & + "The file in which the iron sediment flux forcing field can be found.", & + default="fesedfluxred.nc") + if (scan(CS%fesedfluxred_file,'/') == 0) then + ! Add the directory if CS%fesedflux_file is not already a complete path. + CS%fesedfluxred_file = trim(slasher(inputdir))//trim(CS%fesedfluxred_file) + call log_param(param_file, mdl, "INPUTDIR/MARBL_TRACERS_FESEDFLUXRED_FILE", CS%fesedfluxred_file) + endif ! ** FEVENTFLUX call get_param(param_file, mdl, "MARBL_FEVENTFLUX_FILE", CS%feventflux_file, & "The file in which the iron vent flux forcing field can be found.", & - default="feventflux_5gmol_tx0.66v1.c230817.nc") + default="feventflux.nc") if (scan(CS%feventflux_file,'/') == 0) then ! Add the directory if CS%feventflux_file is not already a complete path. CS%feventflux_file = trim(slasher(inputdir))//trim(CS%feventflux_file) @@ -876,7 +895,7 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag character(len=48) :: flux_units ! The units for age tracer fluxes, either ! years m3 s-1 or years kg s-1. character(len=48) :: tracer_name - logical :: fesedflux_has_edges, fesedflux_use_missing + logical :: fesedflux_has_edges, fesedflux_use_missing, tracer_init_from_Z real :: fesedflux_missing ! required argument for read_Z_edges() [CU ~> conc] integer :: i, j, k, kbot, m, diag_size @@ -955,6 +974,7 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag day, "Conversion Factor for Bottom Flux -> Tend", "1/m") ! Initialize tracers (if they weren't initialized from restart file) + tracer_init_from_Z = .false. do m=1,CS%ntr call query_vardesc(CS%tr_desc(m), name=name, caller="initialize_MARBL_tracers") if ((.not. restart) .or. & @@ -963,12 +983,30 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag ! TODO: added the ongrid optional argument, but is there a good way to detect if the file is on grid? call MOM_initialize_tracer_from_Z(h, CS%tracer_data(m)%tr, G, GV, US, param_file, & CS%IC_file, name, ongrid=CS%ongrid) + tracer_init_from_Z = .true. do k=1,GV%ke ; do j=G%jsc, G%jec ; do i=G%isc, G%iec ! Ensure tracer concentrations are at / above minimum value if (CS%tracer_data(m)%tr(i,j,k) < CS%IC_min) CS%tracer_data(m)%tr(i,j,k) = CS%IC_min enddo ; enddo ; enddo endif enddo + if (tracer_init_from_Z) then + ! For each column, enforce consistency in MARBL tracers + ! (no negative concentrations; for a given autotroph, if one tracer is 0 they all are) + call MOM_error(NOTE, 'Enforcing consistency across autotroph tracer initial conditions') + do j=G%jsc, G%jec ; do i=G%isc, G%iec + ! Copy tracer data into flat array + do k=1,GV%ke; do m=1, CS%ntr + MARBL_instances%tracers(m,k) = CS%tracer_data(m)%tr(i,j,k) + end do ; end do + ! call consistency enforcement + call MARBL_instances%autotroph_tracer_consistency_enforce() + ! Copy tracer data out of flat array + do k=1,GV%ke; do m=1, CS%ntr + CS%tracer_data(m)%tr(i,j,k) = MARBL_instances%tracers(m,k) + end do ; end do + end do ; end do + end if ! Initialize total chlorophyll to get SW Pen correct (if it wasn't initialized from restart file) if ((CS%total_Chl_ind > 0) .and. & @@ -1074,6 +1112,7 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag ! (2) Allocate memory for fesedflux and feventflux allocate(CS%fesedflux_in(SZI_(G), SZJ_(G), CS%fesedflux_nz)) + allocate(CS%fesedfluxred_in(SZI_(G), SZJ_(G), CS%fesedflux_nz)) allocate(CS%feventflux_in(SZI_(G), SZJ_(G), CS%fesedflux_nz)) allocate(CS%fesedflux_dz(SZI_(G), SZJ_(G), CS%fesedflux_nz)) @@ -1081,6 +1120,8 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag ! TODO: Add US term to scale call MOM_read_data(CS%fesedflux_file, "FESEDFLUXIN", CS%fesedflux_in(:,:,:), G%Domain, & scale=CS%fesedflux_scale_factor) + call MOM_read_data(CS%fesedfluxred_file, "FESEDFLUXIN", CS%fesedfluxred_in(:,:,:), G%Domain, & + scale=CS%fesedflux_scale_factor) call MOM_read_data(CS%feventflux_file, "FESEDFLUXIN", CS%feventflux_in(:,:,:), G%Domain, & scale=CS%fesedflux_scale_factor) @@ -1104,6 +1145,8 @@ subroutine initialize_MARBL_tracers(restart, day, G, GV, US, h, param_file, diag if (G%bathyT(i,j) + CS%fesedflux_z_edges(k) < 1e-8 * US%m_to_Z) then CS%fesedflux_in(i,j,k-1) = CS%fesedflux_in(i,j,k-1) + CS%fesedflux_in(i,j,k) CS%fesedflux_in(i,j,k) = 0. + CS%fesedfluxred_in(i,j,k-1) = CS%fesedfluxred_in(i,j,k-1) + CS%fesedfluxred_in(i,j,k) + CS%fesedfluxred_in(i,j,k) = 0. CS%feventflux_in(i,j,k-1) = CS%feventflux_in(i,j,k-1) + CS%feventflux_in(i,j,k) CS%feventflux_in(i,j,k) = 0. CS%fesedflux_dz(i,j,k) = 0. @@ -1185,7 +1228,7 @@ subroutine register_MARBL_diags(MARBL_diags, diag, day, G, id_diags) allocate(id_diags(diag_size)) do m = 1, diag_size id_diags(m)%id = -1 - if (trim(MARBL_diags%diags(m)%vertical_grid) .eq. "none") then ! 2D field + if (trim(MARBL_diags%diags(m)%vertical_grid) == "none") then ! 2D field id_diags(m)%id = register_diag_field("ocean_model", & trim(MARBL_diags%diags(m)%short_name), & diag%axesT1, & ! T => tracer grid? 1 => no vertical grid @@ -1198,7 +1241,9 @@ subroutine register_MARBL_diags(MARBL_diags, diag, day, G, id_diags) ! (for now, FESEDFLUX is the only one that should be true) ! Also, known issue where passing v_extensive=.false. isn't ! treated the same as not passing v_extensive - if (trim(MARBL_diags%diags(m)%short_name).eq."FESEDFLUX") then + if ((trim(MARBL_diags%diags(m)%short_name) == "FESEDFLUX") .or. & + (trim(MARBL_diags%diags(m)%short_name) == "FEREDSEDFLUX") .or. & + (trim(MARBL_diags%diags(m)%short_name) == "FEVENTFLUX")) then id_diags(m)%id = register_diag_field("ocean_model", & trim(MARBL_diags%diags(m)%short_name), & diag%axesTL, & ! T=> tracer grid? L => layer center @@ -1272,15 +1317,13 @@ end subroutine setup_saved_state !> This subroutine applies diapycnal diffusion and any other column !! tracer physics or chemistry to the tracers from this file. -subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, US, CS, tv, & - KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth) +subroutine MARBL_tracers_column_physics(h_old, ea, eb, fluxes, dt, G, GV, US, CS, & + prediabatic_T, prediabatic_S, 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 real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: h_old !< Layer thickness before entrainment [H ~> m or kg m-2]. - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h_new !< Layer thickness after entrainment [H ~> m or kg m-2]. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & intent(in) :: ea !< an array to which the amount of fluid entrained !! from the layer above during this call will be @@ -1295,7 +1338,9 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(MARBL_tracers_CS), pointer :: CS !< The control structure returned by a previous !! call to register_MARBL_tracers. - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + real, dimension(:,:,:), intent(in) :: prediabatic_T !< Temperature prior to calling diabatic driver [C ~> degC] + real, dimension(:,:,:), intent(in) :: prediabatic_S !< Salinity prior to calling diabatic driver [S ~> ppt] + type(KPP_CS), optional, pointer :: KPP_CSp !< KPP control structure real, optional, intent(in) :: nonLocalTrans(:,:,:) !< Non-local transport [1] real, optional, intent(in) :: evap_CFL_limit !< Limit on the fraction of the water that can @@ -1324,11 +1369,13 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, if (.not.associated(CS)) return - ! (1) Compute surface fluxes + ! (1) Compute surface fluxes and interior tendencies ! FIXME: MARBL can handle computing surface fluxes for all columns simultaneously ! I was just thinking going column-by-column at first might be easier + bot_flux_to_tend(:, :, :) = 0. do j=js,je do i=is,ie + ! Surface fluxes ! i. only want ocean points in this loop if (G%mask2dT(i,j) == 0) cycle @@ -1338,9 +1385,9 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, ! TODO: if top layer is vanishly thin, do we actually want (e.g.) top 5m average temp / salinity? ! How does MOM pass SST and SSS to GFDL coupler? (look in core.F90?) if (CS%sss_ind > 0) & - MARBL_instances%surface_flux_forcings(CS%sss_ind)%field_0d(1) = tv%S(i,j,1) * US%S_to_ppt + MARBL_instances%surface_flux_forcings(CS%sss_ind)%field_0d(1) = prediabatic_S(i,j,1) * US%S_to_ppt if (CS%sst_ind > 0) & - MARBL_instances%surface_flux_forcings(CS%sst_ind)%field_0d(1) = tv%T(i,j,1) * US%C_to_degC + MARBL_instances%surface_flux_forcings(CS%sst_ind)%field_0d(1) = prediabatic_T(i,j,1) * US%C_to_degC if (CS%ifrac_ind > 0) & MARBL_instances%surface_flux_forcings(CS%ifrac_ind)%field_0d(1) = fluxes%ice_fraction(i,j) @@ -1406,7 +1453,7 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, call MARBL_instances%StatusLog%log_error_trace("MARBL_instances%surface_flux_compute()", & "MARBL_tracers_column_physics") endif - call print_marbl_log(MARBL_instances%StatusLog) + call print_marbl_log(MARBL_instances%StatusLog, G, i, j) call MARBL_instances%StatusLog%erase() ! iv. Copy output that MOM6 needs to hold on to @@ -1432,158 +1479,15 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS%SFO(i,j,m) = MARBL_instances%surface_flux_output%outputs_for_GCM(m)%forcing_field_0d(1) enddo - enddo - enddo - - if (associated(fluxes%salt_flux)) then - ! convert salt flux to tracer fluxes and add to STF - do j=js,je ; do i=is,ie - net_salt_rate(i,j) = (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j)) * GV%RZ_to_H - enddo ; enddo - - ! DIC related tracers - do j=js,je ; do i=is,ie - flux_from_salt_flux(i,j) = (CS%DIC_salt_ratio * GV%H_to_Z) * net_salt_rate(i,j) - enddo ; enddo - m = CS%tracer_inds%dic_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - m = CS%tracer_inds%dic_alt_co2_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - m = CS%tracer_inds%abio_dic_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - m = CS%tracer_inds%abio_di14c_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - - ! ALK related tracers - do j=js,je ; do i=is,ie - flux_from_salt_flux(i,j) = (CS%ALK_salt_ratio * GV%H_to_Z) * net_salt_rate(i,j) - enddo ; enddo - m = CS%tracer_inds%alk_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - m = CS%tracer_inds%alk_alt_co2_ind - if (m > 0) then - do j=js,je ; do i=is,ie - CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) - enddo ; enddo - if (CS%id_surface_flux_from_salt_flux(m) > 0) & - call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) - endif - endif - - if (CS%debug) then - do m=1,CS%ntr - call hchksum(CS%STF(:,:,m), & - trim(MARBL_instances%tracer_metadata(m)%short_name)//" sfc_flux", G%HI, & - unscale=US%Z_to_m*US%s_to_T) - enddo - endif - - ! (2) Post surface fluxes and their diagnostics (currently all 2D) - do m=1,CS%ntr - if (CS%id_surface_flux_out(m) > 0) & - call post_data(CS%id_surface_flux_out(m), CS%STF(:,:,m), CS%diag) - enddo - do m=1,size(CS%surface_flux_diags) - if (CS%surface_flux_diags(m)%id > 0) & - call post_data(CS%surface_flux_diags(m)%id, CS%surface_flux_diags(m)%field_2d(:,:), CS%diag) - enddo - - ! (3) Apply surface fluxes via vertical diffusion - ! Compute KPP nonlocal term if necessary - if (present(KPP_CSp)) then - if (associated(KPP_CSp) .and. present(nonLocalTrans)) then - do m=1,CS%ntr - call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, CS%STF(:,:,m), dt, & - CS%diag, CS%tracer_data(m)%tr_ptr, CS%tracer_data(m)%tr(:,:,:), & - flux_scale=GV%Z_to_H) - enddo - endif - if (CS%debug) then - do m=1,CS%ntr - call hchksum(CS%tracer_data(m)%tr(:,:,m), & - trim(MARBL_instances%tracer_metadata(m)%short_name)//' post KPP', G%HI) - enddo - endif - endif - - if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then - do m=1,CS%ntr - do k=1,nz ;do j=js,je ; do i=is,ie - h_work(i,j,k) = h_old(i,j,k) - enddo ; enddo ; enddo - ! CS%RIV_FLUXES is conc m/s, in_flux_optional expects time-integrated flux (conc H) - do j=js,je ; do i=is,ie - riv_flux_loc(i,j) = (CS%RIV_FLUXES(i,j,m) * (dt*US%T_to_s)) * GV%m_to_H - enddo ; enddo - if (CS%debug) & - call hchksum(riv_flux_loc(:,:), & - trim(MARBL_instances%tracer_metadata(m)%short_name)//' riv flux', G%HI, unscale=GV%H_to_m) - call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_data(m)%tr(:,:,:) , dt, fluxes, h_work, & - evap_CFL_limit, minimum_forcing_depth, in_flux_optional=riv_flux_loc) - call tracer_vertdiff(h_work, ea, eb, dt, CS%tracer_data(m)%tr(:,:,:), G, GV, & - sfc_flux=GV%Rho0 * CS%STF(:,:,m)) - enddo - else - do m=1,CS%ntr - call tracer_vertdiff(h_old, ea, eb, dt, CS%tracer_data(m)%tr(:,:,:), G, GV, & - sfc_flux=GV%Rho0 * CS%STF(:,:,m)) - enddo - endif - - if (CS%debug) then - do m=1,CS%ntr - call hchksum(CS%tracer_data(m)%tr(:,:,m), & - trim(MARBL_instances%tracer_metadata(m)%short_name)//' post tracer_vertdiff', G%HI) - enddo - endif - - ! (4) Compute interior tendencies - - bot_flux_to_tend(:, :, :) = 0. - do j=js,je - do i=is,ie - ! i. only want ocean points in this loop - if (G%mask2dT(i,j) == 0) cycle - - ! ii. Set up vertical domain and bot_flux_to_tend + ! interior tendencies + ! i. Set up vertical domain and bot_flux_to_tend ! Calculate depth of interface by building up thicknesses from the bottom (top interface is always 0) ! MARBL wants this to be positive-down zi(GV%ke) = G%bathyT(i,j) MARBL_instances%bot_flux_to_tend(:) = 0. cum_bftt_dz = 0. do k = GV%ke, 1, -1 - ! TODO: if we move this above vertical mixing, use h_old - dz(k) = h_new(i,j,k) ! cell thickness + dz(k) = h_old(i,j,k) ! cell thickness zc(k) = zi(k) - 0.5 * (dz(k)*GV%H_to_Z) zi(k-1) = zi(k) - (dz(k)*GV%H_to_Z) if (G%bathyT(i,j) - zi(k-1) <= CS%bot_flux_mix_thickness) then @@ -1605,22 +1509,22 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, MARBL_instances%domain%zt(:) = US%Z_to_m * zc(:) MARBL_instances%domain%delta_z(:) = GV%H_to_m * dz(:) - ! iii. Load proper column data - ! * Forcing Fields + ! ii. Load proper column data + ! * Forcing Fields ! These fields are getting the correct data if (CS%potemp_ind > 0) & - MARBL_instances%interior_tendency_forcings(CS%potemp_ind)%field_1d(1,:) = tv%T(i,j,:) * US%C_to_degC + MARBL_instances%interior_tendency_forcings(CS%potemp_ind)%field_1d(1,:) = prediabatic_T(i,j,:) * US%C_to_degC if (CS%salinity_ind > 0) & - MARBL_instances%interior_tendency_forcings(CS%salinity_ind)%field_1d(1,:) = tv%S(i,j,:) * US%S_to_ppt + MARBL_instances%interior_tendency_forcings(CS%salinity_ind)%field_1d(1,:) = prediabatic_S(i,j,:) * US%S_to_ppt - ! This are okay, but need option to read in from file + ! This is okay, but need option to read in from file ! (Same as dust_dep_ind for surface_flux_forcings) if (CS%dustflux_ind > 0) & MARBL_instances%interior_tendency_forcings(CS%dustflux_ind)%field_0d(1) = & fluxes%dust_flux(i,j) * US%RZ_T_to_kg_m2s - ! TODO: Support PAR (currently just using single subcolumn) - ! (Look for Pen_sw_bnd?) + ! TODO: Support PAR (currently just using single subcolumn) + ! (Look for Pen_sw_bnd?) if (CS%PAR_col_frac_ind > 0) then ! second index is num_subcols, not depth !MARBL_instances%interior_tendency_forcings(CS%PAR_col_frac_ind)%field_1d(1,:) = fluxes%fracr_cat(i,j,:) @@ -1671,9 +1575,23 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, MARBL_instances%interior_tendency_forcings(CS%fesedflux_ind)%field_1d(1,:) = 0. call reintegrate_column(CS%fesedflux_nz, & CS%fesedflux_dz(i,j,:) * (sum(dz(:) * GV%H_to_Z) / G%bathyT(i,j)), & - CS%fesedflux_in(i,j,:) + CS%feventflux_in(i,j,:), GV%ke, dz(:), & + CS%fesedflux_in(i,j,:), GV%ke, dz(:), & MARBL_instances%interior_tendency_forcings(CS%fesedflux_ind)%field_1d(1,:)) endif + if (CS%fesedfluxred_ind > 0) then + MARBL_instances%interior_tendency_forcings(CS%fesedfluxred_ind)%field_1d(1,:) = 0. + call reintegrate_column(CS%fesedflux_nz, & + CS%fesedflux_dz(i,j,:) * (sum(dz(:) * GV%H_to_Z) / G%bathyT(i,j)), & + CS%fesedfluxred_in(i,j,:), GV%ke, dz(:), & + MARBL_instances%interior_tendency_forcings(CS%fesedfluxred_ind)%field_1d(1,:)) + endif + if (CS%feventflux_ind > 0) then + MARBL_instances%interior_tendency_forcings(CS%feventflux_ind)%field_1d(1,:) = 0. + call reintegrate_column(CS%fesedflux_nz, & + CS%fesedflux_dz(i,j,:) * (sum(dz(:) * GV%H_to_Z) / G%bathyT(i,j)), & + CS%feventflux_in(i,j,:), GV%ke, dz(:), & + MARBL_instances%interior_tendency_forcings(CS%feventflux_ind)%field_1d(1,:)) + endif ! TODO: add ability to read these fields from file ! also, add constant values to CS @@ -1694,7 +1612,7 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS%interior_tendency_saved_state(m)%field_3d(i,j,:) enddo - ! iv. Compute interior tendencies in MARBL + ! iii. Compute interior tendencies in MARBL call MARBL_instances%interior_tendency_compute() if (MARBL_instances%StatusLog%labort_marbl) then call MARBL_instances%StatusLog%log_error_trace(& @@ -1703,21 +1621,21 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, call print_marbl_log(MARBL_instances%StatusLog, G, i, j) call MARBL_instances%StatusLog%erase() - ! v. Apply tendencies immediately - ! First pass - Euler step; if stability issues, we can do something different (subcycle?) + ! iv. Apply tendencies immediately + ! First pass - Euler step; if stability issues, we can do something different (subcycle?) do m=1,CS%ntr CS%tracer_data(m)%tr(i,j,:) = CS%tracer_data(m)%tr(i,j,:) + (dt * US%T_to_s) * & MARBL_instances%interior_tendencies(m,:) enddo - ! vi. Copy output that MOM6 needs to hold on to - ! * saved state + ! v. Copy output that MOM6 needs to hold on to + ! * saved state do m=1,size(MARBL_instances%interior_tendency_saved_state%state) CS%interior_tendency_saved_state(m)%field_3d(i,j,:) = & MARBL_instances%interior_tendency_saved_state%state(m)%field_3d(:,1) enddo - ! * diagnostics + ! * diagnostics do m=1,size(MARBL_instances%interior_tendency_diags%diags) if (CS%interior_tendency_diags(m)%id > 0) then if (allocated(CS%interior_tendency_diags(m)%field_2d)) then @@ -1733,7 +1651,7 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, endif enddo - ! * tendency values themselves (and vertical integrals of them) + ! * tendency values themselves (and vertical integrals of them) do m=1,CS%ntr if (allocated(CS%interior_tendency_out(m)%field_3d)) & CS%interior_tendency_out(m)%field_3d(i,j,:) = MARBL_instances%interior_tendencies(m,:) @@ -1761,7 +1679,7 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, endif enddo - ! * Interior tendency output + ! * Interior tendency output do m=1,CS%ito_cnt CS%ITO(i,j,:,m) = & MARBL_instances%interior_tendency_output%outputs_for_GCM(m)%forcing_field_1d(1,:) @@ -1777,10 +1695,147 @@ subroutine MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, enddo endif - ! (5) Post diagnostics from our buffer - ! i. Interior tendency diagnostics (mix of 2D and 3D) - ! ii. Interior tendencies themselves - ! iii. Forcing fields + if (associated(fluxes%salt_flux)) then + ! convert salt flux to tracer fluxes and add to STF + do j=js,je ; do i=is,ie + net_salt_rate(i,j) = (1000.0*US%ppt_to_S * fluxes%salt_flux(i,j)) * GV%RZ_to_H + enddo ; enddo + + ! DIC related tracers + do j=js,je ; do i=is,ie + flux_from_salt_flux(i,j) = (CS%DIC_salt_ratio * GV%H_to_Z) * net_salt_rate(i,j) + enddo ; enddo + m = CS%tracer_inds%dic_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + m = CS%tracer_inds%dic_alt_co2_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + m = CS%tracer_inds%abio_dic_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + m = CS%tracer_inds%abio_di14c_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + + ! ALK related tracers + do j=js,je ; do i=is,ie + flux_from_salt_flux(i,j) = (CS%ALK_salt_ratio * GV%H_to_Z) * net_salt_rate(i,j) + enddo ; enddo + m = CS%tracer_inds%alk_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + m = CS%tracer_inds%alk_alt_co2_ind + if (m > 0) then + do j=js,je ; do i=is,ie + CS%STF(i,j,m) = CS%STF(i,j,m) + flux_from_salt_flux(i,j) + enddo ; enddo + if (CS%id_surface_flux_from_salt_flux(m) > 0) & + call post_data(CS%id_surface_flux_from_salt_flux(m), flux_from_salt_flux, CS%diag) + endif + endif + + if (CS%debug) then + do m=1,CS%ntr + call hchksum(CS%STF(:,:,m), & + trim(MARBL_instances%tracer_metadata(m)%short_name)//" sfc_flux", G%HI, & + unscale=US%Z_to_m*US%s_to_T) + enddo + endif + + ! (2) Apply surface fluxes via vertical diffusion + ! Compute KPP nonlocal term if necessary + if (present(KPP_CSp)) then + if (associated(KPP_CSp) .and. present(nonLocalTrans)) then + do m=1,CS%ntr + call KPP_NonLocalTransport(KPP_CSp, G, GV, h_old, nonLocalTrans, CS%STF(:,:,m), dt, & + CS%diag, CS%tracer_data(m)%tr_ptr, CS%tracer_data(m)%tr(:,:,:), & + flux_scale=GV%Z_to_H) + enddo + endif + if (CS%debug) then + do m=1,CS%ntr + call hchksum(CS%tracer_data(m)%tr(:,:,m), & + trim(MARBL_instances%tracer_metadata(m)%short_name)//' post KPP', G%HI) + enddo + endif + endif + + if (present(evap_CFL_limit) .and. present(minimum_forcing_depth)) then + do m=1,CS%ntr + do k=1,nz ;do j=js,je ; do i=is,ie + h_work(i,j,k) = h_old(i,j,k) + enddo ; enddo ; enddo + ! CS%RIV_FLUXES is conc m/s, in_flux_optional expects time-integrated flux (conc H) + do j=js,je ; do i=is,ie + riv_flux_loc(i,j) = (CS%RIV_FLUXES(i,j,m) * (dt*US%T_to_s)) * GV%m_to_H + enddo ; enddo + if (CS%debug) & + call hchksum(riv_flux_loc(:,:), & + trim(MARBL_instances%tracer_metadata(m)%short_name)//' riv flux', G%HI, unscale=GV%H_to_m) + call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_data(m)%tr(:,:,:) , dt, fluxes, h_work, & + evap_CFL_limit, minimum_forcing_depth, in_flux_optional=riv_flux_loc) + call tracer_vertdiff(h_work, ea, eb, dt, CS%tracer_data(m)%tr(:,:,:), G, GV, & + sfc_flux=GV%Rho0 * CS%STF(:,:,m)) + enddo + else + ! TODO: do we want to support these options? does not apply river fluxes! + ! an alternative would be to require evap_CFL_limit and minimum_forcing_depth. + ! Much like we now require prediabatic_T and prediabatic_S, we can abort + ! in tracer flow control if they are not present. + do m=1,CS%ntr + call tracer_vertdiff(h_old, ea, eb, dt, CS%tracer_data(m)%tr(:,:,:), G, GV, & + sfc_flux=GV%Rho0 * CS%STF(:,:,m)) + enddo + endif + + if (CS%debug) then + do m=1,CS%ntr + call hchksum(CS%tracer_data(m)%tr(:,:,m), & + trim(MARBL_instances%tracer_metadata(m)%short_name)//' post tracer_vertdiff', G%HI) + enddo + endif + + ! (3) Post diagnostics from our buffer + ! i. surface fluxes and their diagnostics (currently all 2D) + ! ii. Interior tendency diagnostics (mix of 2D and 3D) + ! iii. Interior tendencies themselves + ! iv. Forcing fields + do m=1,CS%ntr + if (CS%id_surface_flux_out(m) > 0) & + call post_data(CS%id_surface_flux_out(m), CS%STF(:,:,m), CS%diag) + enddo + + do m=1,size(CS%surface_flux_diags) + if (CS%surface_flux_diags(m)%id > 0) & + call post_data(CS%surface_flux_diags(m)%id, CS%surface_flux_diags(m)%field_2d(:,:), CS%diag) + enddo + if (CS%bot_flux_to_tend_id > 0) & call post_data(CS%bot_flux_to_tend_id, bot_flux_to_tend(:, :, :), CS%diag) @@ -2170,6 +2225,7 @@ subroutine MARBL_tracers_end(CS) if (allocated(CS%tracer_restoring_ind)) deallocate(CS%tracer_restoring_ind) if (allocated(CS%tracer_I_tau_ind)) deallocate(CS%tracer_I_tau_ind) if (allocated(CS%fesedflux_in)) deallocate(CS%fesedflux_in) + if (allocated(CS%fesedfluxred_in)) deallocate(CS%fesedfluxred_in) if (allocated(CS%feventflux_in)) deallocate(CS%feventflux_in) if (allocated(CS%I_tau)) deallocate(CS%I_tau) deallocate(CS) diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index a2d43e80a9..6005a4b668 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -53,7 +53,8 @@ module MOM_tracer_advect !> This routine time steps the tracer concentration using a !! monotonic, conservative, weakly diffusive scheme. subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first_in, & - vol_prev, max_iter_in, update_vol_prev, uhr_out, vhr_out) + vol_prev, max_iter_in, update_vol_prev, uhr_out, vhr_out, & + flux_type) type(ocean_grid_type), intent(inout) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & @@ -71,7 +72,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first type(tracer_registry_type), pointer :: Reg !< pointer to tracer registry logical, optional, intent(in) :: x_first_in !< If present, indicate whether to update !! first in the x- or y-direction. - ! The remaining optional arguments are only used in offline tracer mode. + ! The next four optional arguments are only used in offline tracer mode. real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & optional, intent(inout) :: vol_prev !< Cell volume before advection [H L2 ~> m3 or kg]. !! If update_vol_prev is true, the returned value is @@ -87,7 +88,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), & optional, intent(out) :: vhr_out !< Remaining accumulated volume or mass fluxes !! through the meridional faces [H L2 ~> m3 or kg] - + ! The next optional argument is for diagnosing resolved vs parameterized tracer flux and control + ! which diagnostics are written. The tracers are only updated if flux_type = 0 (the default). Otherwise + ! the routines are dry run to collect diagnostics. + integer, optional, intent(in) :: flux_type !< Indicates whether uhtr, vhtr are the flux due to + !! the residual (= 0), resolved (= 1), or parameterized (= 2) + !! flow + + ! local variables + integer :: flux_type_ctrl !< To allow setting a default value for flux_type real, dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: & hprev ! cell volume at the end of previous tracer change [H L2 ~> m3 or kg] real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)) :: & @@ -104,6 +113,12 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first logical :: domore_u(SZJ_(G),SZK_(GV)) ! domore_u and domore_v indicate whether there is more logical :: domore_v(SZJB_(G),SZK_(GV)) ! advection to be done in the corresponding row or column. logical :: x_first ! If true, advect in the x-direction first. + logical :: advect_this_tracer(Reg%ntr) ! If true, advect the mth tracer. Diagnostics of advection due to the + ! resolved and parameterized flow are collected by re-running the advection + ! routines with different advecting fluxes without updating the tracer. + ! This can be expensive if there are lots of tracers and only a few you + ! want diagnostics about. We therefore only calculate advection on the + ! tracers for which there are active resolved/parameterized diagnostics. integer :: max_iter ! maximum number of iterations in each layer integer :: domore_k(SZK_(GV)) integer :: stencil ! stencil of the advection scheme @@ -116,6 +131,7 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first domore_u(:,:) = .false. domore_v(:,:) = .false. + advect_this_tracer(:) = .false. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB @@ -162,6 +178,10 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first if (present(max_iter_in)) max_iter = max_iter_in if (present(x_first_in)) x_first = x_first_in + + flux_type_ctrl = 0 + if (present(flux_type)) flux_type_ctrl = flux_type ! default to residual flow + call cpu_clock_begin(id_clock_pass) call create_group_pass(CS%pass_uhr_vhr_t_hprev, uhr, vhr, G%Domain) call create_group_pass(CS%pass_uhr_vhr_t_hprev, hprev, G%Domain) @@ -213,15 +233,43 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first vh_neglect(i,J) = GV%H_subroundoff * MIN(G%areaT(i,j), G%areaT(i,j+1)) enddo ; enddo - ! initialize diagnostic fluxes and tendencies - !$OMP do - do m=1,ntr - if (associated(Reg%Tr(m)%ad_x)) Reg%Tr(m)%ad_x(:,:,:) = 0.0 - if (associated(Reg%Tr(m)%ad_y)) Reg%Tr(m)%ad_y(:,:,:) = 0.0 - if (associated(Reg%Tr(m)%advection_xy)) Reg%Tr(m)%advection_xy(:,:,:) = 0.0 - if (associated(Reg%Tr(m)%ad2d_x)) Reg%Tr(m)%ad2d_x(:,:) = 0.0 - if (associated(Reg%Tr(m)%ad2d_y)) Reg%Tr(m)%ad2d_y(:,:) = 0.0 - enddo + ! initialize diagnostic fluxes and tendencies and determine which tracers to advect + if (flux_type_ctrl == 0) then ! Flux is residual + !$OMP do + do m=1,ntr + advect_this_tracer(m) = .true. ! Advect all the tracers regardless of diagnostic output + if (associated(Reg%Tr(m)%ad_x)) Reg%Tr(m)%ad_x(:,:,:) = 0.0 + if (associated(Reg%Tr(m)%ad_y)) Reg%Tr(m)%ad_y(:,:,:) = 0.0 + if (associated(Reg%Tr(m)%advection_xy)) Reg%Tr(m)%advection_xy(:,:,:) = 0.0 + if (associated(Reg%Tr(m)%ad2d_x)) Reg%Tr(m)%ad2d_x(:,:) = 0.0 + if (associated(Reg%Tr(m)%ad2d_y)) Reg%Tr(m)%ad2d_y(:,:) = 0.0 + enddo + elseif (flux_type_ctrl == 1) then ! Flux is resolved + do m=1,ntr + if (associated(Reg%Tr(m)%ad_x_resolved)) then + Reg%Tr(m)%ad_x_resolved(:,:,:) = 0.0 + advect_this_tracer(m) = .true. ! advect this tracer + endif + if (associated(Reg%Tr(m)%ad_y_resolved)) then + Reg%Tr(m)%ad_y_resolved(:,:,:) = 0.0 + advect_this_tracer(m) = .true. ! advect this tracer + endif + enddo + elseif (flux_type_ctrl == 2) then ! Flux is parameterized + do m=1,ntr + if (associated(Reg%Tr(m)%ad_x_param)) then + Reg%Tr(m)%ad_x_param(:,:,:) = 0.0 + advect_this_tracer(m) = .true. ! advect this tracer + endif + if (associated(Reg%Tr(m)%ad_y_param)) then + Reg%Tr(m)%ad_y_param(:,:,:) = 0.0 + advect_this_tracer(m) = .true. ! advect this tracer + endif + enddo + else + call MOM_error(FATAL, & + "Inconsistent flux type in advect_tracer. Must be of 0 (residual), 1 (resolved), or 2 (parameterized)") + endif ! flux_type_ctrl !$OMP end parallel isv = is ; iev = ie ; jsv = js ; jev = je @@ -279,14 +327,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first ! First, advect zonally. call advect_x(Reg%Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & isv, iev, jsv-stencil, jev+stencil, k, G, GV, US, & - local_advect_scheme) + flux_type_ctrl, advect_this_tracer, local_advect_scheme) endif ; enddo !$OMP do ordered do k=1,nz ; if (domore_k(k) > 0) then ! Next, advect meridionally. call advect_y(Reg%Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, US, local_advect_scheme) + isv, iev, jsv, jev, k, G, GV, US, flux_type_ctrl, advect_this_tracer, & + local_advect_scheme) ! Update domore_k(k) for the next iteration domore_k(k) = 0 @@ -302,14 +351,15 @@ subroutine advect_tracer(h_end, uhtr, vhtr, OBC, dt, G, GV, US, CS, Reg, x_first ! First, advect meridionally. call advect_y(Reg%Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & isv-stencil, iev+stencil, jsv, jev, k, G, GV, US, & - local_advect_scheme) + flux_type_ctrl, advect_this_tracer, local_advect_scheme) endif ; enddo !$OMP do ordered do k=1,nz ; if (domore_k(k) > 0) then ! Next, advect zonally. call advect_x(Reg%Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - isv, iev, jsv, jev, k, G, GV, US, local_advect_scheme) + isv, iev, jsv, jev, k, G, GV, US, flux_type_ctrl, advect_this_tracer, & + local_advect_scheme) ! Update domore_k(k) for the next iteration domore_k(k) = 0 @@ -355,7 +405,8 @@ end subroutine advect_tracer !> This subroutine does 1-d flux-form advection in the zonal direction using !! a monotonic piecewise linear scheme. subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & - is, ie, js, je, k, G, GV, US, advect_schemes) + is, ie, js, je, k, G, GV, US, flux_type, advect_this_tracer, & + advect_schemes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: ntr !< The number of tracers @@ -376,6 +427,10 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: flux_type !< Indicates whether uhtr, vhtr are the flux + !! due to the residual (= 0), resolved (= 1), + !! or parameterized (= 2) flow + logical, dimension(ntr), intent(in) :: advect_this_tracer !< If true, advect this tracer integer, dimension(ntr), intent(in) :: advect_schemes !< list of advection schemes to use real, dimension(SZI_(G),ntr) :: & @@ -439,34 +494,40 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! Calculate the i-direction profiles (slopes) of each tracer that is being advected. if (usePLMslope) then - do m=1,ntr ; do i=is-stencil,ie+stencil - !if (ABS(Tr(m)%t(i+1,j,k)-Tr(m)%t(i,j,k)) < & - ! ABS(Tr(m)%t(i,j,k)-Tr(m)%t(i-1,j,k))) then - ! maxslope = 4.0*(Tr(m)%t(i+1,j,k)-Tr(m)%t(i,j,k)) - !else - ! maxslope = 4.0*(Tr(m)%t(i,j,k)-Tr(m)%t(i-1,j,k)) - !endif - !if ((Tr(m)%t(i+1,j,k)-Tr(m)%t(i,j,k)) * (Tr(m)%t(i,j,k)-Tr(m)%t(i-1,j,k)) < 0.0) then - ! slope_x(i,m) = 0.0 - !elseif (ABS(Tr(m)%t(i+1,j,k)-Tr(m)%t(i-1,j,k))= 0.0) then + i_up = i + else + i_up = i+1 + endif - if ((advect_schemes(m) == ADVECT_PPM) .or. (advect_schemes(m) == ADVECT_PPMH3)) then - do I=is-1,ie - ! centre cell depending on upstream direction - if (uhh(I) >= 0.0) then - i_up = i - else - i_up = i+1 - endif - - ! Implementation of PPM-H3 - Tp = T_tmp(i_up+1,m) ; Tc = T_tmp(i_up,m) ; Tm = T_tmp(i_up-1,m) - - if (advect_schemes(m) == ADVECT_PPMH3) then - aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate - aL = max( min(Tc,Tm), aL) ; aL = min( max(Tc,Tm), aL) ! Bound - aR = ( 5.*Tc + ( 2.*Tp - Tm ) )/6. ! H3 estimate - aR = max( min(Tc,Tp), aR) ; aR = min( max(Tc,Tp), aR) ! Bound - else - aL = 0.5 * ((Tm + Tc) + (slope_x(i_up-1,m) - slope_x(i_up,m)) / 3.) - aR = 0.5 * ((Tc + Tp) + (slope_x(i_up,m) - slope_x(i_up+1,m)) / 3.) - endif + ! Implementation of PPM-H3 + Tp = T_tmp(i_up+1,m) ; Tc = T_tmp(i_up,m) ; Tm = T_tmp(i_up-1,m) + + if (advect_schemes(m) == ADVECT_PPMH3) then + aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate + aL = max( min(Tc,Tm), aL) ; aL = min( max(Tc,Tm), aL) ! Bound + aR = ( 5.*Tc + ( 2.*Tp - Tm ) )/6. ! H3 estimate + aR = max( min(Tc,Tp), aR) ; aR = min( max(Tc,Tp), aR) ! Bound + else + aL = 0.5 * ((Tm + Tc) + (slope_x(i_up-1,m) - slope_x(i_up,m)) / 3.) + aR = 0.5 * ((Tc + Tp) + (slope_x(i_up,m) - slope_x(i_up+1,m)) / 3.) + endif - dA = aR - aL ; mA = 0.5*( aR + aL ) - if (G%mask2dCu(I_up,j)*G%mask2dCu(I_up-1,j)*(Tp-Tc)*(Tc-Tm) <= 0.) then - aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells - elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then - aL = (3.*Tc) - 2.*aR - elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then - aR = (3.*Tc) - 2.*aL - endif + dA = aR - aL ; mA = 0.5*( aR + aL ) + if (G%mask2dCu(I_up,j)*G%mask2dCu(I_up-1,j)*(Tp-Tc)*(Tc-Tm) <= 0.) then + aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells + elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then + aL = (3.*Tc) - 2.*aR + elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then + aR = (3.*Tc) - 2.*aL + endif - a6 = 6.*Tc - 3. * (aR + aL) ! Curvature + a6 = 6.*Tc - 3. * (aR + aL) ! Curvature - if (uhh(I) >= 0.0) then - flux_x(I,j,m) = uhh(I)*( aR - 0.5 * CFL(I) * ( & - ( aR - aL ) - a6 * ( 1. - 2./3. * CFL(I) ) ) ) - else - flux_x(I,j,m) = uhh(I)*( aL + 0.5 * CFL(I) * ( & - ( aR - aL ) + a6 * ( 1. - 2./3. * CFL(I) ) ) ) - endif - enddo - else ! PLM - do I=is-1,ie - if (uhh(I) >= 0.0) then - ! Indirect implementation of PLM - !aL = Tr(m)%t(i,j,k) - 0.5 * slope_x(i,m) - !aR = Tr(m)%t(i,j,k) + 0.5 * slope_x(i,m) - !flux_x(I,j,m) = uhh(I)*( aR - 0.5 * (aR-aL) * CFL(I) ) - ! Alternative implementation of PLM - Tc = T_tmp(i,m) - flux_x(I,j,m) = uhh(I)*( Tc + 0.5 * slope_x(i,m) * ( 1. - CFL(I) ) ) - else - ! Indirect implementation of PLM - !aL = Tr(m)%t(i+1,j,k) - 0.5 * slope_x(i+1,m) - !aR = Tr(m)%t(i+1,j,k) + 0.5 * slope_x(i+1,m) - !flux_x(I,j,m) = uhh(I)*( aL + 0.5 * (aR-aL) * CFL(I) ) - ! Alternative implementation of PLM - Tc = T_tmp(i+1,m) - flux_x(I,j,m) = uhh(I)*( Tc - 0.5 * slope_x(i+1,m) * ( 1. - CFL(I) ) ) - endif - enddo - endif ! usePPM + if (uhh(I) >= 0.0) then + flux_x(I,j,m) = uhh(I)*( aR - 0.5 * CFL(I) * ( & + ( aR - aL ) - a6 * ( 1. - 2./3. * CFL(I) ) ) ) + else + flux_x(I,j,m) = uhh(I)*( aL + 0.5 * CFL(I) * ( & + ( aR - aL ) + a6 * ( 1. - 2./3. * CFL(I) ) ) ) + endif + enddo + else ! PLM + do I=is-1,ie + if (uhh(I) >= 0.0) then + ! Indirect implementation of PLM + !aL = Tr(m)%t(i,j,k) - 0.5 * slope_x(i,m) + !aR = Tr(m)%t(i,j,k) + 0.5 * slope_x(i,m) + !flux_x(I,j,m) = uhh(I)*( aR - 0.5 * (aR-aL) * CFL(I) ) + ! Alternative implementation of PLM + Tc = T_tmp(i,m) + flux_x(I,j,m) = uhh(I)*( Tc + 0.5 * slope_x(i,m) * ( 1. - CFL(I) ) ) + else + ! Indirect implementation of PLM + !aL = Tr(m)%t(i+1,j,k) - 0.5 * slope_x(i+1,m) + !aR = Tr(m)%t(i+1,j,k) + 0.5 * slope_x(i+1,m) + !flux_x(I,j,m) = uhh(I)*( aL + 0.5 * (aR-aL) * CFL(I) ) + ! Alternative implementation of PLM + Tc = T_tmp(i+1,m) + flux_x(I,j,m) = uhh(I)*( Tc - 0.5 * slope_x(i+1,m) * ( 1. - CFL(I) ) ) + endif + enddo + endif ! usePPM + endif ! advect_this_tracer enddo if (associated(OBC)) then ; if (OBC%OBC_pe) then @@ -625,9 +691,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! should the reservoir evolve for this case Kate ?? - Nope do m=1,segment%tr_Reg%ntseg ntr_id = segment%tr_reg%Tr(m)%ntr_index - if (allocated(segment%tr_Reg%Tr(m)%tres)) then - flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) - else ; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + if (advect_this_tracer(ntr_id)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then + flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) + else ; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + endif ! advect_this_tracer enddo endif endif @@ -649,9 +717,11 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & uhh(I) = uhr(I,j,k) do m=1,segment%tr_Reg%ntseg ntr_id = segment%tr_reg%Tr(m)%ntr_index - if (allocated(segment%tr_Reg%Tr(m)%tres)) then - flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) - else; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif + if (advect_this_tracer(ntr_id)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then + flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%tres(I,j,k) + else; flux_x(I,j,ntr_id) = uhh(I)*segment%tr_Reg%Tr(m)%OBC_inflow_conc; endif + endif ! advect_this_tracer enddo endif endif @@ -694,61 +764,78 @@ subroutine advect_x(Tr, hprev, uhr, uh_neglect, OBC, domore_u, ntr, Idt, & ! update tracer concentration from i-flux and save some diagnostics do m=1,ntr + if (advect_this_tracer(m)) then - ! update tracer - do i=is,ie - if (do_i(i,j)) then - if (Ihnew(i) > 0.0) then - Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & - (flux_x(I,j,m) - flux_x(I-1,j,m))) * Ihnew(i) + ! update tracer + if (flux_type == 0) then ! Only update tracer if using residual flux + do i=is,ie + if (do_i(i,j)) then + if (Ihnew(i) > 0.0) then + Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & + (flux_x(I,j,m) - flux_x(I-1,j,m))) * Ihnew(i) + endif + endif + enddo + endif ! flux_type == 0 + + ! diagnostics + if (flux_type == 0) then + if (associated(Tr(m)%ad_x)) then ; do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then + Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,j,m)*Idt + endif ; enddo ; endif + + ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). + ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. + if (associated(Tr(m)%advection_xy)) then + do i=is,ie ; if (do_i(i,j)) then + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_x(I,j,m) - flux_x(I-1,j,m)) * & + Idt * G%IareaT(i,j) + endif ; enddo endif - endif - enddo - - ! diagnostics - if (associated(Tr(m)%ad_x)) then ; do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then - Tr(m)%ad_x(I,j,k) = Tr(m)%ad_x(I,j,k) + flux_x(I,j,m)*Idt - endif ; enddo ; endif - - ! diagnose convergence of flux_x (do not use the Ihnew(i) part of the logic). - ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. - if (associated(Tr(m)%advection_xy)) then - do i=is,ie ; if (do_i(i,j)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - & - (flux_x(I,j,m) - flux_x(I-1,j,m)) * & - Idt * G%IareaT(i,j) - endif ; enddo - endif - + elseif (flux_type == 1) then + if (associated(Tr(m)%ad_x_resolved)) then ; do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then + Tr(m)%ad_x_resolved(I,j,k) = Tr(m)%ad_x_resolved(I,j,k) + flux_x(I,j,m)*Idt + endif ; enddo ; endif + elseif (flux_type == 2) then + if (associated(Tr(m)%ad_x_param)) then ; do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then + Tr(m)%ad_x_param(I,j,k) = Tr(m)%ad_x_param(I,j,k) + flux_x(I,j,m)*Idt + endif ; enddo ; endif + endif ! the case of flux_type not equal 0, 1, or 2 is caught in advect_tracer above. + endif ! advect_this_tracer enddo endif ; enddo ! End of j-loop. ! Do user controlled underflow of the tracer concentrations. - do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then - do j=js,je ; do i=is,ie - if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 - enddo ; enddo - endif ; enddo + if (flux_type == 0) then ! Only update tracer if using residual flux + do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then + do j=js,je ; do i=is,ie + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo + endif ; enddo + endif ! compute ad2d_x diagnostic outside above j-loop so as to make the summation ordered when OMP is active. - !$OMP ordered - do m=1,ntr ; if (associated(Tr(m)%ad2d_x)) then - do j=js,je ; if (domore_u_initial(j,k)) then - do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then - Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,j,m)*Idt + if (flux_type == 0) then ! Only update tracer if using residual flux + !$OMP ordered + do m=1,ntr ; if (associated(Tr(m)%ad2d_x)) then + do j=js,je ; if (domore_u_initial(j,k)) then + do I=is-1,ie ; if (do_i(i,j) .or. do_i(i+1,j)) then + Tr(m)%ad2d_x(I,j) = Tr(m)%ad2d_x(I,j) + flux_x(I,j,m)*Idt + endif ; enddo endif ; enddo - endif ; enddo - endif ; enddo ! End of m-loop. - !$OMP end ordered + endif ; enddo ! End of m-loop. + !$OMP end ordered + endif end subroutine advect_x !> This subroutine does 1-d flux-form advection using a monotonic piecewise !! linear scheme. subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & - is, ie, js, je, k, G, GV, US, advect_schemes) + is, ie, js, je, k, G, GV, US, flux_type, advect_this_tracer, & + advect_schemes) type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure integer, intent(in) :: ntr !< The number of tracers @@ -769,6 +856,10 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & integer, intent(in) :: je !< The ending tracer j-index to work on integer, intent(in) :: k !< The k-level to work on type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + integer, intent(in) :: flux_type !< Indicates whether uhtr, vhtr are the flux + !! due to the residual (= 0), resolved (= 1), + !! or parameterized (= 2) flow + logical, dimension(ntr), intent(in) :: advect_this_tracer !< If true, advect this tracer integer, dimension(ntr), intent(in) :: advect_schemes !< list of advection schemes to use real, dimension(SZI_(G),ntr,SZJ_(G)) :: & @@ -840,35 +931,43 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! Calculate the j-direction profiles (slopes) of each tracer that ! is being advected. if (usePLMslope) then - do j=js-stencil,je+stencil ; if (do_j_tr(j)) then ; do m=1,ntr ; do i=is,ie - !if (ABS(Tr(m)%t(i,j+1,k)-Tr(m)%t(i,j,k)) < & - ! ABS(Tr(m)%t(i,j,k)-Tr(m)%t(i,j-1,k))) then - ! maxslope = 4.0*(Tr(m)%t(i,j+1,k)-Tr(m)%t(i,j,k)) - !else - ! maxslope = 4.0*(Tr(m)%t(i,j,k)-Tr(m)%t(i,j-1,k)) - !endif - !if ((Tr(m)%t(i,j+1,k)-Tr(m)%t(i,j,k))*(Tr(m)%t(i,j,k)-Tr(m)%t(i,j-1,k)) < 0.0) then - ! slope_y(i,m,j) = 0.0 - !elseif (ABS(Tr(m)%t(i,j+1,k)-Tr(m)%t(i,j-1,k))= 0.0) then + j_up = j + else + j_up = j + 1 + endif - if ((advect_schemes(m) == ADVECT_PPM) .or. (advect_schemes(m) == ADVECT_PPMH3)) then - do i=is,ie - ! centre cell depending on upstream direction - if (vhh(i,J) >= 0.0) then - j_up = j - else - j_up = j + 1 - endif - - ! Implementation of PPM-H3 - Tp = T_tmp(i,m,j_up+1) ; Tc = T_tmp(i,m,j_up) ; Tm = T_tmp(i,m,j_up-1) - - if (advect_schemes(m) == ADVECT_PPMH3) then - aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate - aL = max( min(Tc,Tm), aL) ; aL = min( max(Tc,Tm), aL) ! Bound - aR = ( 5.*Tc + ( 2.*Tp - Tm ) )/6. ! H3 estimate - aR = max( min(Tc,Tp), aR) ; aR = min( max(Tc,Tp), aR) ! Bound - else - aL = 0.5 * ((Tm + Tc) + (slope_y(i,m,j_up-1) - slope_y(i,m,j_up)) / 3.) - aR = 0.5 * ((Tc + Tp) + (slope_y(i,m,j_up) - slope_y(i,m,j_up+1)) / 3.) - endif + ! Implementation of PPM-H3 + Tp = T_tmp(i,m,j_up+1) ; Tc = T_tmp(i,m,j_up) ; Tm = T_tmp(i,m,j_up-1) + + if (advect_schemes(m) == ADVECT_PPMH3) then + aL = ( 5.*Tc + ( 2.*Tm - Tp ) )/6. ! H3 estimate + aL = max( min(Tc,Tm), aL) ; aL = min( max(Tc,Tm), aL) ! Bound + aR = ( 5.*Tc + ( 2.*Tp - Tm ) )/6. ! H3 estimate + aR = max( min(Tc,Tp), aR) ; aR = min( max(Tc,Tp), aR) ! Bound + else + aL = 0.5 * ((Tm + Tc) + (slope_y(i,m,j_up-1) - slope_y(i,m,j_up)) / 3.) + aR = 0.5 * ((Tc + Tp) + (slope_y(i,m,j_up) - slope_y(i,m,j_up+1)) / 3.) + endif - dA = aR - aL ; mA = 0.5*( aR + aL ) - if (G%mask2dCv(i,J_up)*G%mask2dCv(i,J_up-1)*(Tp-Tc)*(Tc-Tm) <= 0.) then - aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells - elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then - aL = (3.*Tc) - 2.*aR - elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then - aR = (3.*Tc) - 2.*aL - endif + dA = aR - aL ; mA = 0.5*( aR + aL ) + if (G%mask2dCv(i,J_up)*G%mask2dCv(i,J_up-1)*(Tp-Tc)*(Tc-Tm) <= 0.) then + aL = Tc ; aR = Tc ! PCM for local extrema and boundary cells + elseif ( dA*(Tc-mA) > (dA*dA)/6. ) then + aL = (3.*Tc) - 2.*aR + elseif ( dA*(Tc-mA) < - (dA*dA)/6. ) then + aR = (3.*Tc) - 2.*aL + endif - a6 = 6.*Tc - 3. * (aR + aL) ! Curvature + a6 = 6.*Tc - 3. * (aR + aL) ! Curvature - if (vhh(i,J) >= 0.0) then - flux_y(i,m,J) = vhh(i,J)*( aR - 0.5 * CFL(i) * ( & - ( aR - aL ) - a6 * ( 1. - 2./3. * CFL(I) ) ) ) - else - flux_y(i,m,J) = vhh(i,J)*( aL + 0.5 * CFL(i) * ( & - ( aR - aL ) + a6 * ( 1. - 2./3. * CFL(I) ) ) ) - endif - enddo - else ! PLM - do i=is,ie - if (vhh(i,J) >= 0.0) then - ! Indirect implementation of PLM - !aL = Tr(m)%t(i,j,k) - 0.5 * slope_y(i,m,j) - !aR = Tr(m)%t(i,j,k) + 0.5 * slope_y(i,m,j) - !flux_y(i,m,J) = vhh(i,J)*( aR - 0.5 * (aR-aL) * CFL(i) ) - ! Alternative implementation of PLM - Tc = T_tmp(i,m,j) - flux_y(i,m,J) = vhh(i,J)*( Tc + 0.5 * slope_y(i,m,j) * ( 1. - CFL(i) ) ) - else - ! Indirect implementation of PLM - !aL = Tr(m)%t(i,j+1,k) - 0.5 * slope_y(i,m,j+1) - !aR = Tr(m)%t(i,j+1,k) + 0.5 * slope_y(i,m,j+1) - !flux_y(i,m,J) = vhh(i,J)*( aL + 0.5 * (aR-aL) * CFL(i) ) - ! Alternative implementation of PLM - Tc = T_tmp(i,m,j+1) - flux_y(i,m,J) = vhh(i,J)*( Tc - 0.5 * slope_y(i,m,j+1) * ( 1. - CFL(i) ) ) - endif - enddo - endif ! usePPM + if (vhh(i,J) >= 0.0) then + flux_y(i,m,J) = vhh(i,J)*( aR - 0.5 * CFL(i) * ( & + ( aR - aL ) - a6 * ( 1. - 2./3. * CFL(I) ) ) ) + else + flux_y(i,m,J) = vhh(i,J)*( aL + 0.5 * CFL(i) * ( & + ( aR - aL ) + a6 * ( 1. - 2./3. * CFL(I) ) ) ) + endif + enddo + else ! PLM + do i=is,ie + if (vhh(i,J) >= 0.0) then + ! Indirect implementation of PLM + !aL = Tr(m)%t(i,j,k) - 0.5 * slope_y(i,m,j) + !aR = Tr(m)%t(i,j,k) + 0.5 * slope_y(i,m,j) + !flux_y(i,m,J) = vhh(i,J)*( aR - 0.5 * (aR-aL) * CFL(i) ) + ! Alternative implementation of PLM + Tc = T_tmp(i,m,j) + flux_y(i,m,J) = vhh(i,J)*( Tc + 0.5 * slope_y(i,m,j) * ( 1. - CFL(i) ) ) + else + ! Indirect implementation of PLM + !aL = Tr(m)%t(i,j+1,k) - 0.5 * slope_y(i,m,j+1) + !aR = Tr(m)%t(i,j+1,k) + 0.5 * slope_y(i,m,j+1) + !flux_y(i,m,J) = vhh(i,J)*( aL + 0.5 * (aR-aL) * CFL(i) ) + ! Alternative implementation of PLM + Tc = T_tmp(i,m,j+1) + flux_y(i,m,J) = vhh(i,J)*( Tc - 0.5 * slope_y(i,m,j+1) * ( 1. - CFL(i) ) ) + endif + enddo + endif ! usePPM + endif ! advect_this_tracer enddo if (associated(OBC)) then ; if (OBC%OBC_pe) then @@ -1030,11 +1134,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = vhr(i,J,k) do m=1,segment%tr_Reg%ntseg ntr_id = segment%tr_reg%Tr(m)%ntr_index - if (allocated(segment%tr_Reg%Tr(m)%tres)) then - flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) - else - flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc - endif + if (advect_this_tracer(ntr_id)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then + flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%tres(i,J,k) + else ; flux_y(i,ntr_id,J) = vhh(i,J)*OBC%segment(n)%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + endif ! advect_this_tracer enddo endif enddo @@ -1056,9 +1160,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & vhh(i,J) = vhr(i,J,k) do m=1,segment%tr_Reg%ntseg ntr_id = segment%tr_reg%Tr(m)%ntr_index - if (allocated(segment%tr_Reg%Tr(m)%tres)) then - flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) - else ; flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + if (advect_this_tracer(ntr_id)) then + if (allocated(segment%tr_Reg%Tr(m)%tres)) then + flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%tres(i,J,k) + else ; flux_y(i,ntr_id,J) = vhh(i,J)*segment%tr_Reg%Tr(m)%OBC_inflow_conc ; endif + endif ! advect_this_tracer enddo endif enddo @@ -1069,7 +1175,11 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & else ! not domore_v. do i=is,ie ; vhh(i,J) = 0.0 ; enddo - do m=1,ntr ; do i=is,ie ; flux_y(i,m,J) = 0.0 ; enddo ; enddo + do m=1,ntr + if (advect_this_tracer(m)) then + do i=is,ie ; flux_y(i,m,J) = 0.0 ; enddo + endif ! advect_this_tracer + enddo endif ; enddo ! End of j-loop do J=js-1,je ; do i=is,ie @@ -1107,49 +1217,75 @@ subroutine advect_y(Tr, hprev, vhr, vh_neglect, OBC, domore_v, ntr, Idt, & ! update tracer and save some diagnostics do m=1,ntr - do i=is,ie ; if (do_i(i,j)) then - Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & - (flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i) - endif ; enddo - - ! diagnose convergence of flux_y and add to convergence of flux_x. - ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. - if (associated(Tr(m)%advection_xy)) then - do i=is,ie ; if (do_i(i,j)) then - Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - & - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & - G%IareaT(i,j) - endif ; enddo - endif + if (advect_this_tracer(m)) then + if (flux_type == 0) then ! Only update tracer if using residual flux + do i=is,ie ; if (do_i(i,j)) then + Tr(m)%t(i,j,k) = (Tr(m)%t(i,j,k) * hlst(i) - & + (flux_y(i,m,J) - flux_y(i,m,J-1))) * Ihnew(i) + endif ; enddo + ! diagnose convergence of flux_y and add to convergence of flux_x. + ! division by areaT to get into W/m2 for heat and kg/(s*m2) for salt. + if (associated(Tr(m)%advection_xy)) then + do i=is,ie ; if (do_i(i,j)) then + Tr(m)%advection_xy(i,j,k) = Tr(m)%advection_xy(i,j,k) - (flux_y(i,m,J) - flux_y(i,m,J-1))* Idt * & + G%IareaT(i,j) + endif ; enddo + endif + endif ! flux_type == 0 + endif ! advect_this_tracer enddo endif ; enddo ! End of j-loop. ! Do user controlled underflow of the tracer concentrations. - do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then - do j=js,je ; do i=is,ie - if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 - enddo ; enddo - endif ; enddo + if (flux_type == 0) then ! Only update tracer if using residual flux + do m=1,ntr ; if (Tr(m)%conc_underflow > 0.0) then + do j=js,je ; do i=is,ie + if (abs(Tr(m)%t(i,j,k)) < Tr(m)%conc_underflow) Tr(m)%t(i,j,k) = 0.0 + enddo ; enddo + endif ; enddo + endif ! compute ad_y and ad2d_y diagnostic outside above j-loop so as to make the summation ordered when OMP is active. - !$OMP ordered - do m=1,ntr ; if (associated(Tr(m)%ad_y)) then - do J=js-1,je ; if (domore_v_initial(J)) then - do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then - Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + if (flux_type == 0) then + !$OMP ordered + do m=1,ntr ; if (associated(Tr(m)%ad_y)) then + do J=js-1,je ; if (domore_v_initial(J)) then + do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then + Tr(m)%ad_y(i,J,k) = Tr(m)%ad_y(i,J,k) + flux_y(i,m,J)*Idt + endif ; enddo endif ; enddo - endif ; enddo - endif ; enddo ! End of m-loop. + endif ; enddo ! End of m-loop. - do m=1,ntr ; if (associated(Tr(m)%ad2d_y)) then - do J=js-1,je ; if (domore_v_initial(J)) then - do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then - Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + do m=1,ntr ; if (associated(Tr(m)%ad2d_y)) then + do J=js-1,je ; if (domore_v_initial(J)) then + do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then + Tr(m)%ad2d_y(i,J) = Tr(m)%ad2d_y(i,J) + flux_y(i,m,J)*Idt + endif ; enddo endif ; enddo - endif ; enddo - endif ; enddo ! End of m-loop. - !$OMP end ordered + endif ; enddo ! End of m-loop. + !$OMP end ordered + elseif (flux_type == 1) then + !$OMP ordered + do m=1,ntr ; if (associated(Tr(m)%ad_y_resolved)) then + do J=js-1,je ; if (domore_v_initial(J)) then + do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then + Tr(m)%ad_y_resolved(i,J,k) = Tr(m)%ad_y_resolved(i,J,k) + flux_y(i,m,J)*Idt + endif ; enddo + endif ; enddo + endif ; enddo ! End of m-loop. + !$OMP end ordered + elseif (flux_type == 2) then + !$OMP ordered + do m=1,ntr ; if (associated(Tr(m)%ad_y_param)) then + do J=js-1,je ; if (domore_v_initial(J)) then + do i=is,ie ; if (do_i(i,j) .or. do_i(i,j+1)) then + Tr(m)%ad_y_param(i,J,k) = Tr(m)%ad_y_param(i,J,k) + flux_y(i,m,J)*Idt + endif ; enddo + endif ; enddo + endif ; enddo ! End of m-loop. + !$OMP end ordered + endif ! the case of flux_type not equal 0, 1, or 2 is caught in advect_tracer above. end subroutine advect_y diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index dc8f3a37fb..33db88fe3f 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -83,7 +83,7 @@ module MOM_tracer_flow_control public call_tracer_register, tracer_flow_control_init, call_tracer_set_forcing public call_tracer_column_fns, call_tracer_surface_state, call_tracer_stocks public call_tracer_flux_init, get_chl_from_model, tracer_flow_control_end -public call_tracer_register_obc_segments +public call_tracer_register_obc_segments, extract_tracer_flow_member !> The control structure for orchestrating the calling of tracer packages type, public :: tracer_flow_control_CS ; private @@ -203,7 +203,7 @@ subroutine call_tracer_register(G, GV, US, param_file, CS, tr_Reg, restart_CS) call get_param(param_file, mdl, "USE_IDEAL_AGE_TRACER", CS%use_ideal_age, & "If true, use the ideal_age_example tracer package.", & default=.false.) - call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_marbl_tracers, & + call get_param(param_file, mdl, "USE_MARBL_TRACERS", CS%use_MARBL_tracers, & "If true, use the MARBL tracer package.", & default=.false.) call get_param(param_file, mdl, "USE_REGIONAL_DYES", CS%use_regional_dyes, & @@ -417,6 +417,17 @@ subroutine get_chl_from_model(Chl_array, G, GV, CS) end subroutine get_chl_from_model +!> Returns pointers or values of members within the tracer_flow_control_CS type. For extensibility, +!! each returned argument is an optional argument +subroutine extract_tracer_flow_member(CS, use_MARBL_tracers) + type(tracer_flow_control_CS), target, intent(in) :: CS !< module control structure + ! All output arguments are optional + logical, optional, intent(out) :: use_MARBL_tracers !< If true, MARBL tracers are active + + ! Constants within tracer_flow_control_CS + if (present(use_MARBL_tracers)) use_MARBL_tracers = CS%use_MARBL_tracers +end subroutine extract_tracer_flow_member + !> This subroutine calls the individual tracer modules' subroutines to !! specify or read quantities related to their surface forcing. subroutine call_tracer_set_forcing(sfc_state, fluxes, day_start, day_interval, G, US, Rho0, CS) @@ -452,7 +463,8 @@ 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, h_BL) + debug, KPP_CSp, nonLocalTrans, evap_CFL_limit, minimum_forcing_depth, & + h_BL, prediabatic_T, prediabatic_S) 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 @@ -488,6 +500,10 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, 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] real, dimension(:,:), optional, pointer :: h_BL !< Thickness of active mixing layer [H ~> m or kg m-2] + real, dimension(:,:,:), optional, intent(in) :: prediabatic_T !< Temperature prior to calling + !! diabatic driver [C ~> degC] + real, dimension(:,:,:), optional, intent(in) :: prediabatic_S !< Salinity prior to calling + !! diabatic driver [S ~> ppt] ! Local variables real :: Hbl(SZI_(G),SZJ_(G)) !< Boundary layer thickness [H ~> m or kg m-2] @@ -529,13 +545,17 @@ 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, Hbl=Hbl) endif - if (CS%use_MARBL_tracers) & - call MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%MARBL_tracers_CSp, tv, & + if (CS%use_MARBL_tracers) then + if ((.not. present(prediabatic_T)) .or. (.not. present(prediabatic_S))) & + call MOM_error(FATAL, 'Must pass prediabatic_T and prediabatic_S when using MARBL') + call MARBL_tracers_column_physics(h_old, ea, eb, fluxes, dt, & + G, GV, US, CS%MARBL_tracers_CSp, & + prediabatic_T, prediabatic_S, & KPP_CSp=KPP_CSp, & nonLocalTrans=nonLocalTrans, & evap_CFL_limit=evap_CFL_limit, & minimum_forcing_depth=minimum_forcing_depth) + 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, & @@ -619,11 +639,15 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, mld, dt, G, GV, 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 - if (CS%use_MARBL_tracers) & - call MARBL_tracers_column_physics(h_old, h_new, ea, eb, fluxes, dt, & - G, GV, US, CS%MARBL_tracers_CSp, tv, & + if (CS%use_MARBL_tracers) then + if ((.not. present(prediabatic_T)) .or. (.not. present(prediabatic_S))) & + call MOM_error(FATAL, 'Must pass prediabatic_T and prediabatic_S when using MARBL') + call MARBL_tracers_column_physics(h_old, ea, eb, fluxes, dt, & + G, GV, US, CS%MARBL_tracers_CSp, & + prediabatic_T, prediabatic_S, & KPP_CSp=KPP_CSp, & nonLocalTrans=nonLocalTrans) + 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) diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index 3e8429f884..c550f73ef5 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -507,21 +507,43 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ enddo enddo enddo + if (CS%KhTr_use_vert_struct) then - do K=2,nz+1 - do J=js-1,je - do i=is,ie - Coef_y(i,J,K) = Coef_y(i,J,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i,j+1,k-1) ) + if (CS%full_depth_khtr_min) then + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = Coef_y(i,J,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i,j+1,k-1) ) + Coef_min = I_numitts * dt * (CS%KhTr_min*(G%dx_Cv(i,J)*G%IdyCv(i,J))) + Coef_y(i,J,K) = max(Coef_y(i,J,K), Coef_min) + enddo enddo enddo - enddo - do k=2,nz+1 - do j=js,je - do I=is-1,ie - Coef_x(I,j,K) = Coef_x(I,j,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i+1,j,k-1) ) + do k=2,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = Coef_x(I,j,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i+1,j,k-1) ) + Coef_min = I_numitts * dt * (CS%KhTr_min*(G%dy_Cu(I,j)*G%IdxCu(I,j))) + Coef_x(I,j,K) = max(Coef_x(I,j,K), Coef_min) + enddo enddo enddo - enddo + else + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Coef_y(i,J,K) = Coef_y(i,J,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i,j+1,k-1) ) + enddo + enddo + enddo + do k=2,nz+1 + do j=js,je + do I=is-1,ie + Coef_x(I,j,K) = Coef_x(I,j,1) * 0.5 * ( VarMix%ebt_struct(i,j,k-1) + VarMix%ebt_struct(i+1,j,k-1) ) + enddo + enddo + enddo + endif endif do itt=1,num_itts @@ -635,13 +657,24 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ Kh_u(I,j,:) = G%mask2dCu(I,j)*Kh_u(I,j,1) enddo ; enddo if (CS%KhTr_use_vert_struct) then - do K=2,nz+1 - do j=js,je - do I=is-1,ie - Kh_u(I,j,K) = Kh_u(I,j,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i+1,j,k-1) ) + if (CS%full_depth_khtr_min) then + do K=2,nz+1 + do j=js,je + do I=is-1,ie + Kh_u(I,j,K) = Kh_u(I,j,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i+1,j,k-1) ) + Kh_u(I,j,K) = max(Kh_u(I,j,K), CS%KhTr_min) + enddo enddo enddo - enddo + else + do K=2,nz+1 + do j=js,je + do I=is-1,ie + Kh_u(I,j,K) = Kh_u(I,j,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i+1,j,k-1) ) + enddo + enddo + enddo + endif endif !call post_data(CS%id_KhTr_u, Kh_u, CS%diag, is_static=.false., mask=G%mask2dCu) call post_data(CS%id_KhTr_u, Kh_u, CS%diag) @@ -651,13 +684,24 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ Kh_v(i,J,:) = G%mask2dCv(i,J)*Kh_v(i,J,1) enddo ; enddo if (CS%KhTr_use_vert_struct) then - do K=2,nz+1 - do J=js-1,je - do i=is,ie - Kh_v(i,J,K) = Kh_v(i,J,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i,j+1,k-1) ) + if (CS%full_depth_khtr_min) then + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Kh_v(i,J,K) = Kh_v(i,J,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i,j+1,k-1) ) + Kh_v(i,J,K) = max(Kh_v(i,J,K), CS%KhTr_min) + enddo enddo enddo - enddo + else + do K=2,nz+1 + do J=js-1,je + do i=is,ie + Kh_v(i,J,K) = Kh_v(i,J,1) * 0.5 * ( VarMix%khtr_struct(i,j,k-1) + VarMix%khtr_struct(i,j+1,k-1) ) + enddo + enddo + enddo + endif endif !call post_data(CS%id_KhTr_v, Kh_v, CS%diag, is_static=.false., mask=G%mask2dCv) call post_data(CS%id_KhTr_v, Kh_v, CS%diag) @@ -677,10 +721,19 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, visc, G, GV, US, CS, Reg, tv, do_ Kh_h(i,j,:) = normalize*G%mask2dT(i,j)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & (Kh_v(i,J-1,1)+Kh_v(i,J,1))) if (CS%KhTr_use_vert_struct) then - do K=2,nz+1 - Kh_h(i,j,K) = normalize*G%mask2dT(i,j)*VarMix%khtr_struct(i,j,k-1)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & - (Kh_v(i,J-1,1)+Kh_v(i,J,1))) - enddo + if (CS%full_depth_khtr_min) then + do K=2,nz+1 + Kh_h(i,j,K) = normalize*G%mask2dT(i,j)*VarMix%khtr_struct(i,j,k-1)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & + (Kh_v(i,J-1,1)+Kh_v(i,J,1))) + Kh_h(i,j,K) = max(Kh_h(i,j,K), CS%KhTr_min) + enddo + + else + do K=2,nz+1 + Kh_h(i,j,K) = normalize*G%mask2dT(i,j)*VarMix%khtr_struct(i,j,k-1)*((Kh_u(I-1,j,1)+Kh_u(I,j,1)) + & + (Kh_v(i,J-1,1)+Kh_v(i,J,1))) + enddo + endif endif enddo ; enddo !call post_data(CS%id_KhTr_h, Kh_h, CS%diag, is_static=.false., mask=G%mask2dT) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index 50220be343..08860c3ccb 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -18,11 +18,13 @@ module MOM_tracer_registry use MOM_file_parser, only : get_param, log_version, param_file_type use MOM_hor_index, only : hor_index_type use MOM_grid, only : ocean_grid_type +use MOM_interface_heights, only : thickness_to_dz use MOM_io, only : vardesc, query_vardesc, cmor_long_std use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_string_functions, only : lowercase use MOM_time_manager, only : time_type use MOM_unit_scaling, only : unit_scale_type +use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type use MOM_tracer_types, only : tracer_type, tracer_registry_type @@ -34,6 +36,7 @@ module MOM_tracer_registry public MOM_tracer_chksum, MOM_tracer_chkinv public register_tracer_diagnostics public post_tracer_diagnostics_at_sync, post_tracer_transport_diagnostics +public post_tracer_integral_diagnostics public preALE_tracer_diagnostics, postALE_tracer_diagnostics public tracer_registry_init, lock_tracer_registry, tracer_registry_end public tracer_name_lookup @@ -365,6 +368,22 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, u diag%axesCvL, Time, trim(flux_longname)//" advective meridional flux" , & trim(flux_units), v_extensive=.true., x_cell_method='sum', & conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T) + Tr%id_adx_resolved = register_diag_field("ocean_model", trim(shortnm)//"_adx_resolved", & + diag%axesCuL, Time, trim(flux_longname)//" resolved advective zonal flux" , & + trim(flux_units), v_extensive=.true., y_cell_method='sum', & + conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T) + Tr%id_ady_resolved = register_diag_field("ocean_model", trim(shortnm)//"_ady_resolved", & + diag%axesCvL, Time, trim(flux_longname)//" resolved advective meridional flux" , & + trim(flux_units), v_extensive=.true., x_cell_method='sum', & + conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T) + Tr%id_adx_param = register_diag_field("ocean_model", trim(shortnm)//"_adx_param", & + diag%axesCuL, Time, trim(flux_longname)//" parameterized advective zonal flux" , & + trim(flux_units), v_extensive=.true., y_cell_method='sum', & + conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T) + Tr%id_ady_param = register_diag_field("ocean_model", trim(shortnm)//"_ady_param", & + diag%axesCvL, Time, trim(flux_longname)//" resolved parameterized meridional flux" , & + trim(flux_units), v_extensive=.true., x_cell_method='sum', & + conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T) Tr%id_dfx = register_diag_field("ocean_model", trim(shortnm)//"_dfx", & diag%axesCuL, Time, trim(flux_longname)//" diffusive zonal flux" , & trim(flux_units), v_extensive=.true., y_cell_method='sum', & @@ -389,6 +408,18 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, u Tr%id_ady = register_diag_field("ocean_model", trim(shortnm)//"_ady", & diag%axesCvL, Time, "Advective (by residual mean) Meridional Flux of "//trim(flux_longname), & flux_units, v_extensive=.true., conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T, x_cell_method='sum') + Tr%id_adx_resolved = register_diag_field("ocean_model", trim(shortnm)//"_adx_resolved", & + diag%axesCuL, Time, "Advective (by resolved flow) Zonal Flux of "//trim(flux_longname), & + flux_units, v_extensive=.true., conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T, y_cell_method='sum') + Tr%id_ady_resolved = register_diag_field("ocean_model", trim(shortnm)//"_ady_resolved", & + diag%axesCvL, Time, "Advective (by resolved flow) Meridional Flux of "//trim(flux_longname), & + flux_units, v_extensive=.true., conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T, x_cell_method='sum') + Tr%id_adx_param = register_diag_field("ocean_model", trim(shortnm)//"_adx_param", & + diag%axesCuL, Time, "Advective (by parameterized flow) Zonal Flux of "//trim(flux_longname), & + flux_units, v_extensive=.true., conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T, y_cell_method='sum') + Tr%id_ady_param = register_diag_field("ocean_model", trim(shortnm)//"_ady_param", & + diag%axesCvL, Time, "Advective (by parameterized flow) Meridional Flux of "//trim(flux_longname), & + flux_units, v_extensive=.true., conversion=Tr%flux_scale*(US%L_to_m**2)*US%s_to_T, x_cell_method='sum') Tr%id_dfx = register_diag_field("ocean_model", trim(shortnm)//"_diffx", & diag%axesCuL, Time, "Diffusive Zonal Flux of "//trim(flux_longname), & flux_units, v_extensive=.true., conversion=(US%L_to_m**2)*Tr%flux_scale*US%s_to_T, & @@ -411,15 +442,19 @@ subroutine register_tracer_diagnostics(Reg, h, Time, diag, G, GV, US, use_ALE, u Tr%id_zint = register_diag_field("ocean_model", trim(shortnm)//"_zint", & diag%axesT1, Time, & "Thickness-weighted integral of " // trim(longname), & - trim(units) // " m") + trim(units) // " m", conversion=Tr%conc_scale*US%Z_to_m) Tr%id_zint_100m = register_diag_field("ocean_model", trim(shortnm)//"_zint_100m", & diag%axesT1, Time, & "Thickness-weighted integral of "// trim(longname) // " over top 100m", & - trim(units) // " m") + trim(units) // " m", conversion=Tr%conc_scale*US%Z_to_m) Tr%id_surf = register_diag_field("ocean_model", trim(shortnm)//"_SURF", & - diag%axesT1, Time, "Surface values of "// trim(longname), trim(units)) + diag%axesT1, Time, "Surface values of "// trim(longname), trim(units), conversion=Tr%conc_scale) if (Tr%id_adx > 0) call safe_alloc_ptr(Tr%ad_x,IsdB,IedB,jsd,jed,nz) if (Tr%id_ady > 0) call safe_alloc_ptr(Tr%ad_y,isd,ied,JsdB,JedB,nz) + if (Tr%id_adx_resolved > 0) call safe_alloc_ptr(Tr%ad_x_resolved,IsdB,IedB,jsd,jed,nz) + if (Tr%id_ady_resolved > 0) call safe_alloc_ptr(Tr%ad_y_resolved,isd,ied,JsdB,JedB,nz) + if (Tr%id_adx_param > 0) call safe_alloc_ptr(Tr%ad_x_param,IsdB,IedB,jsd,jed,nz) + if (Tr%id_ady_param > 0) call safe_alloc_ptr(Tr%ad_y_param,isd,ied,JsdB,JedB,nz) if (Tr%id_dfx > 0) call safe_alloc_ptr(Tr%df_x,IsdB,IedB,jsd,jed,nz) if (Tr%id_dfy > 0) call safe_alloc_ptr(Tr%df_y,isd,ied,JsdB,JedB,nz) if (Tr%id_hbd_dfx > 0) call safe_alloc_ptr(Tr%hbd_dfx,IsdB,IedB,jsd,jed,nz) @@ -762,50 +797,22 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) intent(in) :: h_diag !< Layer thicknesses on which to post fields [H ~> m or kg m-2] type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output - integer :: i, j, k, is, ie, js, je, nz, m, khi + integer :: i, j, k, is, ie, js, je, nz, m real :: work2d(SZI_(G),SZJ_(G)) ! The vertically integrated convergence of lateral advective ! tracer fluxes [CU H T-1 ~> conc m s-1 or conc kg m-2 s-1] - real :: frac_under_100m(SZI_(G),SZJ_(G),SZK_(GV)) ! weights used to compute 100m vertical integrals [nondim] - real :: ztop(SZI_(G),SZJ_(G)) ! position of the top interface [H ~> m or kg m-2] - real :: zbot(SZI_(G),SZJ_(G)) ! position of the bottom interface [H ~> m or kg m-2] type(tracer_type), pointer :: Tr=>NULL() is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - ! If any tracers are posting 100m vertical integrals, compute weights - frac_under_100m(:,:,:) = 0.0 - ! khi will be the largest layer index corresponding where ztop < 100m and ztop >= 100m - ! in any column (we can reduce computation of 100m integrals by only looping through khi - ! rather than GV%ke) - khi = 0 - do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then - Tr => Reg%Tr(m) - if (Tr%id_zint_100m > 0) then - zbot(:,:) = 0.0 - do k=1, nz - do j=js,je ; do i=is,ie - ztop(i,j) = zbot(i,j) - zbot(i,j) = ztop(i,j) + h_diag(i,j,k)*GV%H_to_m - if (zbot(i,j) <= 100.0) then - frac_under_100m(i,j,k) = 1.0 - elseif (ztop(i,j) < 100.0) then - frac_under_100m(i,j,k) = (100.0 - ztop(i,j)) / (zbot(i,j) - ztop(i,j)) - else - frac_under_100m(i,j,k) = 0.0 - endif - ! frac_under_100m(i,j,k) = max(0, min(1.0, (100.0 - ztop(i,j)) / (zbot(i,j) - ztop(i,j)))) - enddo ; enddo - if (any(frac_under_100m(:,:,k) > 0)) khi = k - enddo - exit - endif - endif; enddo - do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then Tr => Reg%Tr(m) if (Tr%id_tr_post_horzn> 0) call post_data(Tr%id_tr_post_horzn, Tr%t, diag) if (Tr%id_adx > 0) call post_data(Tr%id_adx, Tr%ad_x, diag, alt_h=h_diag) if (Tr%id_ady > 0) call post_data(Tr%id_ady, Tr%ad_y, diag, alt_h=h_diag) + if (Tr%id_adx_resolved > 0) call post_data(Tr%id_adx_resolved, Tr%ad_x_resolved, diag, alt_h=h_diag) + if (Tr%id_ady_resolved > 0) call post_data(Tr%id_ady_resolved, Tr%ad_y_resolved, diag, alt_h=h_diag) + if (Tr%id_adx_param > 0) call post_data(Tr%id_adx_param, Tr%ad_x_param, diag, alt_h=h_diag) + if (Tr%id_ady_param > 0) call post_data(Tr%id_ady_param, Tr%ad_y_param, diag, alt_h=h_diag) if (Tr%id_dfx > 0) call post_data(Tr%id_dfx, Tr%df_x, diag, alt_h=h_diag) if (Tr%id_dfy > 0) call post_data(Tr%id_dfy, Tr%df_y, diag, alt_h=h_diag) if (Tr%id_adx_2d > 0) call post_data(Tr%id_adx_2d, Tr%ad2d_x, diag) @@ -820,13 +827,83 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) enddo ; enddo ; enddo call post_data(Tr%id_adv_xy_2d, work2d, diag) endif + endif ; enddo +end subroutine post_tracer_transport_diagnostics + +!> Post diagnostics of vertically integrated tracer amouints +subroutine post_tracer_integral_diagnostics(G, GV, US, Reg, h_diag, tv, diag) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type + type(tracer_registry_type), pointer :: Reg !< pointer to the tracer registry + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: h_diag !< Layer thicknesses on which to post fields [H ~> m or kg m-2] + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(diag_ctrl), intent(in) :: diag !< structure to regulate diagnostic output + + integer :: i, j, k, is, ie, js, je, nz, m, khi + real :: work2d(SZI_(G),SZJ_(G)) ! The vertically integrated tracer amounts [CU Z T-1 ~> conc m] + real :: dz(SZI_(G),SZJ_(G),SZK_(GV)) !< Geometric layer thicknesses in height units [Z ~> m] + real :: frac_under_100m(SZI_(G),SZJ_(G),SZK_(GV)) ! weights used to compute 100m vertical integrals [nondim] + real :: ztop(SZI_(G),SZJ_(G)) ! position of the top interface [Z ~> m] + real :: zbot(SZI_(G),SZJ_(G)) ! position of the bottom interface [Z ~> m] + real :: Z_100 ! 100 m in depth units [Z ~> m] + logical :: dz_needed, dz100_used + type(tracer_type), pointer :: Tr=>NULL() + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + dz_needed = .false. + dz100_used = .false. + do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then + if (Reg%Tr(m)%id_zint_100m > 0) dz100_used = .true. + if (Reg%Tr(m)%id_zint > 0) dz_needed = .true. + endif ; enddo + if (dz100_used) dz_needed = .true. + + if (dz_needed) then + ! Convert the layer thicknesses into geometric depths, using the pre-stored layer-mean specific + ! volumes when in non-Boussinesq mode. + call thickness_to_dz(h_diag, tv, dz, G, GV, US) + endif + + if (dz100_used) then + ! If any tracers are posting 100m vertical integrals, compute weights + frac_under_100m(:,:,:) = 0.0 + ! khi will be the largest layer index corresponding where ztop < 100m and ztop >= 100m + ! in any column (we can reduce computation of 100m integrals by only looping through khi + ! rather than GV%ke) + khi = 0 + + Z_100 = 100.0*US%m_to_Z + zbot(:,:) = 0.0 + do k=1,nz + do j=js,je ; do i=is,ie + ztop(i,j) = zbot(i,j) + zbot(i,j) = ztop(i,j) + dz(i,j,k) + if (zbot(i,j) <= Z_100) then + frac_under_100m(i,j,k) = 1.0 + elseif (ztop(i,j) < Z_100) then + frac_under_100m(i,j,k) = (Z_100 - ztop(i,j)) / (zbot(i,j) - ztop(i,j)) + else + frac_under_100m(i,j,k) = 0.0 + endif + ! frac_under_100m(i,j,k) = max(0, min(1.0, (Z_100 - ztop(i,j)) / (zbot(i,j) - ztop(i,j)))) + enddo ; enddo + if (any(frac_under_100m(:,:,k) > 0)) khi = k + enddo + endif + + do m=1,Reg%ntr ; if (Reg%Tr(m)%registry_diags) then + Tr => Reg%Tr(m) ! A few diagnostics introduce with MARBL driver ! Compute full-depth vertical integral if (Tr%id_zint > 0) then work2d(:,:) = 0.0 do k=1,nz ; do j=js,je ; do i=is,ie - work2d(i,j) = work2d(i,j) + (h_diag(i,j,k)*GV%H_to_m)*tr%t(i,j,k) + work2d(i,j) = work2d(i,j) + dz(i,j,k)*tr%t(i,j,k) enddo ; enddo ; enddo call post_data(Tr%id_zint, work2d, diag) endif @@ -835,7 +912,7 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) if (Tr%id_zint_100m > 0) then work2d(:,:) = 0.0 do k=1,khi ; do j=js,je ; do i=is,ie - work2d(i,j) = work2d(i,j) + frac_under_100m(i,j,k)*((h_diag(i,j,k)*GV%H_to_m)*tr%t(i,j,k)) + work2d(i,j) = work2d(i,j) + frac_under_100m(i,j,k) * dz(i,j,k)*Tr%t(i,j,k) enddo ; enddo ; enddo call post_data(Tr%id_zint_100m, work2d, diag) endif @@ -844,7 +921,7 @@ subroutine post_tracer_transport_diagnostics(G, GV, Reg, h_diag, diag) if (Tr%id_SURF > 0) call post_data(Tr%id_SURF, Tr%t(:,:,1), diag) endif ; enddo -end subroutine post_tracer_transport_diagnostics +end subroutine post_tracer_integral_diagnostics !> This subroutine writes out chksums for the first ntr registered tracers. subroutine tracer_array_chksum(mesg, Tr, ntr, G) diff --git a/src/tracer/MOM_tracer_types.F90 b/src/tracer/MOM_tracer_types.F90 index 730a453695..68a6f7da4f 100644 --- a/src/tracer/MOM_tracer_types.F90 +++ b/src/tracer/MOM_tracer_types.F90 @@ -23,6 +23,14 @@ module MOM_tracer_types !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:,:), pointer :: ad_y => NULL() !< diagnostic array for y-advective tracer flux !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_x_resolved => NULL() !< diagnostic array for x-advective resolved tracer flux + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_y_resolved => NULL() !< diagnostic array for y-advective resolved tracer flux + !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_x_param => NULL() !< diagnostic array for x-advective parameterized tracer + !! flux [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] + real, dimension(:,:,:), pointer :: ad_y_param => NULL() !< diagnostic array for y-advective parameterized tracer + !! flux [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_x => NULL() !< diagnostic vertical sum x-advective tracer flux !! [CU H L2 T-1 ~> conc m3 s-1 or conc kg s-1] real, dimension(:,:), pointer :: ad2d_y => NULL() !< diagnostic vertical sum y-advective tracer flux @@ -109,6 +117,7 @@ module MOM_tracer_types !>@{ Diagnostic IDs integer :: id_tr = -1, id_tr_post_horzn = -1 integer :: id_adx = -1, id_ady = -1, id_dfx = -1, id_dfy = -1 + integer :: id_adx_resolved = -1, id_ady_resolved = -1, id_adx_param = -1, id_ady_param = -1 integer :: id_hbd_dfx = -1, id_hbd_dfy = -1 integer :: id_hbd_dfx_2d = -1, id_hbd_dfy_2d = -1 integer :: id_adx_2d = -1, id_ady_2d = -1, id_dfx_2d = -1, id_dfy_2d = -1