diff --git a/config_src/coupled_driver/MOM_surface_forcing.F90 b/config_src/coupled_driver/MOM_surface_forcing.F90 index 39d56ad89d..a16031b291 100644 --- a/config_src/coupled_driver/MOM_surface_forcing.F90 +++ b/config_src/coupled_driver/MOM_surface_forcing.F90 @@ -885,7 +885,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res character(len=200) :: TideAmp_file, gust_file, salt_file, temp_file ! Input file names. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger character(len=240) :: basin_file integer :: i, j, isd, ied, jsd, jed @@ -906,26 +906,26 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res call write_version_number (version) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, & + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & default=".") CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mod, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & + call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) - call get_param(param_file, mod, "MAX_P_SURF", CS%max_p_surf, & + call get_param(param_file, mdl, "MAX_P_SURF", CS%max_p_surf, & "The maximum surface pressure that can be exerted by the \n"//& "atmosphere and floating sea-ice or ice shelves. This is \n"//& "needed because the FMS coupling structure does not \n"//& @@ -933,31 +933,31 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res "the ice-ocean heat fluxes are treated explicitly. No \n"//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) - call get_param(param_file, mod, "ADJUST_NET_SRESTORE_TO_ZERO", & + call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_TO_ZERO", & CS%adjust_net_srestore_to_zero, & "If true, adjusts the salinity restoring seen to zero\n"//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) - call get_param(param_file, mod, "ADJUST_NET_SRESTORE_BY_SCALING", & + call get_param(param_file, mdl, "ADJUST_NET_SRESTORE_BY_SCALING", & CS%adjust_net_srestore_by_scaling, & "If true, adjustments to salt restoring to achieve zero net are\n"//& "made by scaling values without moving the zero contour.",& default=.false.) - call get_param(param_file, mod, "ADJUST_NET_FRESH_WATER_TO_ZERO", & + call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_TO_ZERO", & CS%adjust_net_fresh_water_to_zero, & "If true, adjusts the net fresh-water forcing seen \n"//& "by the ocean (including restoring) to zero.", default=.false.) - call get_param(param_file, mod, "ADJUST_NET_FRESH_WATER_BY_SCALING", & + call get_param(param_file, mdl, "ADJUST_NET_FRESH_WATER_BY_SCALING", & CS%adjust_net_fresh_water_by_scaling, & "If true, adjustments to net fresh water to achieve zero net are\n"//& "made by scaling values without moving the zero contour.",& default=.false.) - call get_param(param_file, mod, "ICE_SALT_CONCENTRATION", & + call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & "The assumed sea-ice salinity needed to reverse engineer the \n"//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) - call get_param(param_file, mod, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & + call get_param(param_file, mdl, "USE_LIMITED_PATM_SSH", CS%use_limited_P_SSH, & "If true, return the sea surface height with the \n"//& "correction for the atmospheric (and sea-ice) pressure \n"//& "limited by max_p_surf instead of the full atmospheric \n"//& @@ -965,10 +965,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res ! smg: should get_param call should be removed when have A=B code reconciled. ! this param is used to distinguish how to diagnose surface heat content from water. - call get_param(param_file, mod, "BULKMIXEDLAYER", CS%bulkmixedlayer, & + call get_param(param_file, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & default=CS%use_temperature,do_not_log=.true.) - call get_param(param_file, mod, "WIND_STAGGER", stagger, & + call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& "staggering of the input wind stress field. Valid \n"//& "values are 'A', 'B', or 'C'.", default="C") @@ -977,43 +977,43 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res elseif (uppercase(stagger(1:1)) == 'C') then ; CS%wind_stagger = CGRID_NE else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mod, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & + call get_param(param_file, mdl, "WIND_STRESS_MULTIPLIER", CS%wind_stress_multiplier, & "A factor multiplying the wind-stress given to the ocean by the\n"//& "coupler. This is used for testing and should be =1.0 for any\n"//& "production runs.", default=1.0) if (restore_salt) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) - call get_param(param_file, mod, "SALT_RESTORE_FILE", CS%salt_restore_file, & + call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & "A file in which to find the surface salinity to use for restoring.", & default="salt_restore.nc") - call get_param(param_file, mod, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & + call get_param(param_file, mdl, "SALT_RESTORE_VARIABLE", CS%salt_restore_var_name, & "The name of the surface salinity variable to read from "//& "SALT_RESTORE_FILE for restoring salinity.", & default="salt") ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 - call get_param(param_file, mod, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & + call get_param(param_file, mdl, "SRESTORE_AS_SFLUX", CS%salt_restore_as_sflux, & "If true, the restoring of salinity is applied as a salt \n"//& "flux instead of as a freshwater flux.", default=.false.) - call get_param(param_file, mod, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & + call get_param(param_file, mdl, "MAX_DELTA_SRESTORE", CS%max_delta_srestore, & "The maximum salinity difference used in restoring terms.", & units="PSU or g kg-1", default=999.0) - call get_param(param_file, mod, "MASK_SRESTORE_UNDER_ICE", & + call get_param(param_file, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & "If true, disables SSS restoring under sea-ice based on a frazil\n"//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) - call get_param(param_file, mod, "MASK_SRESTORE_MARGINAL_SEAS", & + call get_param(param_file, mdl, "MASK_SRESTORE_MARGINAL_SEAS", & CS%mask_srestore_marginal_seas, & "If true, disable SSS restoring in marginal seas. Only used when\n"//& "RESTORE_SALINITY is True.", default=.false.) - call get_param(param_file, mod, "BASIN_FILE", basin_file, & + call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & default="basin.nc") basin_file = trim(CS%inputdir) // trim(basin_file) @@ -1028,22 +1028,22 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res endif if (restore_temp) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) - call get_param(param_file, mod, "SST_RESTORE_FILE", CS%temp_restore_file, & + call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & "A file in which to find the surface temperature to use for restoring.", & default="temp_restore.nc") - call get_param(param_file, mod, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & + call get_param(param_file, mdl, "SST_RESTORE_VARIABLE", CS%temp_restore_var_name, & "The name of the surface temperature variable to read from "//& "SST_RESTORE_FILE for restoring sst.", & default="temp") ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 - call get_param(param_file, mod, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & + call get_param(param_file, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) @@ -1053,20 +1053,20 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res ! Otherwise use default tidal amplitude for bottom frictionally-generated ! dissipation. Default cd_tides is chosen to yield approx 1 TWatt of ! work done against tides globally using OSU tidal amplitude. - call get_param(param_file, mod, "CD_TIDES", CS%cd_tides, & + call get_param(param_file, mdl, "CD_TIDES", CS%cd_tides, & "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) - call get_param(param_file, mod, "READ_TIDEAMP", CS%read_TIDEAMP, & + call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then - call get_param(param_file, mod, "TIDEAMP_FILE", TideAmp_file, & + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 else - call get_param(param_file, mod, "UTIDE", CS%utide, & + call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0) endif @@ -1095,14 +1095,14 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res ! Optionally read a x-y gustiness field in place of a global ! constant. - call get_param(param_file, mod, "READ_GUST_2D", CS%read_gust_2d, & + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from \n"//& "an input file", default=.false.) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) if (CS%read_gust_2d) then - call get_param(param_file, mod, "GUST_2D_FILE", gust_file, & + call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in \n"//& "variable gustiness.") @@ -1113,31 +1113,31 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, restore_salt, res endif ! See whether sufficiently thick sea ice should be treated as rigid. - call get_param(param_file, mod, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & + call get_param(param_file, mdl, "USE_RIGID_SEA_ICE", CS%rigid_sea_ice, & "If true, sea-ice is rigid enough to exert a \n"//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then - call get_param(param_file, mod, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & + call get_param(param_file, mdl, "SEA_ICE_MEAN_DENSITY", CS%density_sea_ice, & "A typical density of sea ice, used with the kinematic \n"//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) - call get_param(param_file, mod, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & + call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & "The kinematic viscosity of sufficiently thick sea ice \n"//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) - call get_param(param_file, mod, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & + call get_param(param_file, mdl, "SEA_ICE_RIGID_MASS", CS%rigid_sea_ice_mass, & "The mass of sea-ice per unit area at which the sea-ice \n"//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif - call get_param(param_file, mod, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & + call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & "If true, makes available diagnostics of fluxes from icebergs\n"//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) - call get_param(param_file, mod, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & + call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & "If true, allows flux adjustments to specified via the \n"//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then diff --git a/config_src/coupled_driver/ocean_model_MOM.F90 b/config_src/coupled_driver/ocean_model_MOM.F90 index 8a5f934d12..5d9e077888 100644 --- a/config_src/coupled_driver/ocean_model_MOM.F90 +++ b/config_src/coupled_driver/ocean_model_MOM.F90 @@ -36,7 +36,7 @@ module ocean_model_mod use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : calculate_surface_state, finish_MOM_initialization -use MOM, only : step_tracers +use MOM, only : step_offline use MOM_constants, only : CELSIUS_KELVIN_OFFSET, hlf use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end @@ -222,7 +222,7 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in) real :: G_Earth ! The gravitational acceleration in m s-2. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "ocean_model_init" ! This module's name. + character(len=40) :: mdl = "ocean_model_init" ! This module's name. character(len=48) :: stagger integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters @@ -248,22 +248,22 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in) OS%fluxes%C_p = OS%MOM_CSp%tv%C_p ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "RESTART_CONTROL", OS%Restart_control, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & "An integer whose bits encode which restart files are \n"//& "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& "(bit 0) for a non-time-stamped file. A restart file \n"//& "will be saved at the end of the run segment for any \n"//& "non-negative value.", default=1) - call get_param(param_file, mod, "TIMEUNIT", Time_unit, & + call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & "The time unit for ENERGYSAVEDAYS.", & units="s", default=86400.0) - call get_param(param_file, mod, "ENERGYSAVEDAYS",OS%energysavedays, & + call get_param(param_file, mdl, "ENERGYSAVEDAYS",OS%energysavedays, & "The interval in units of TIMEUNIT between saves of the \n"//& "energies of the run and other globally summed diagnostics.", & default=set_time(0,days=1), timeunit=Time_unit) - call get_param(param_file, mod, "OCEAN_SURFACE_STAGGER", stagger, & + call get_param(param_file, mdl, "OCEAN_SURFACE_STAGGER", stagger, & "A case-insensitive character string to indicate the \n"//& "staggering of the surface velocity field that is \n"//& "returned to the coupler. Valid values include \n"//& @@ -274,38 +274,38 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in) else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & trim(stagger)//" is invalid.") ; endif - call get_param(param_file, mod, "RESTORE_SALINITY",OS%restore_salinity, & + call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & "If true, the coupled driver will add a globally-balanced \n"//& "fresh-water flux that drives sea-surface salinity \n"//& "toward specified values.", default=.false.) - call get_param(param_file, mod, "RESTORE_TEMPERATURE",OS%restore_temp, & + call get_param(param_file, mdl, "RESTORE_TEMPERATURE",OS%restore_temp, & "If true, the coupled driver will add a \n"//& "heat flux that drives sea-surface temperauture \n"//& "toward specified values.", default=.false.) - call get_param(param_file, mod, "RHO_0", Rho0, & + call get_param(param_file, mdl, "RHO_0", Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "G_EARTH", G_Earth, & + call get_param(param_file, mdl, "G_EARTH", G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "ICE_SHELF", OS%use_ice_shelf, & + call get_param(param_file, mdl, "ICE_SHELF", OS%use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) - call get_param(param_file, mod, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & + call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) if (OS%icebergs_apply_rigid_boundary) then - call get_param(param_file, mod, "KV_ICEBERG", OS%kv_iceberg, & + call get_param(param_file, mdl, "KV_ICEBERG", OS%kv_iceberg, & "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) - call get_param(param_file, mod, "DENSITY_ICEBERGS", OS%density_iceberg, & + call get_param(param_file, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & "A typical density of icebergs.", units="kg m-3", default=917.0) - call get_param(param_file, mod, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mod, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & + call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & "Fraction of grid cell which iceberg must occupy, so that fluxes \n"//& "below berg are set to zero. Not applied for negative \n"//& " values.", units="non-dim", default=-1.0) @@ -472,7 +472,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%MOM_Csp%offline_tracer_mode) then - call step_tracers(OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) + call step_offline(OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) else call step_MOM(OS%fluxes, OS%state, Time1, time_step, OS%MOM_CSp) endif @@ -879,25 +879,28 @@ end subroutine ocean_model_init_sfc !WGA subroutine ocean_model_flux_init(OS) - type(ocean_state_type), pointer :: OS + type(ocean_state_type), optional, pointer :: OS + integer :: dummy character(len=128) :: default_ice_restart_file, default_ocean_restart_file - character(len=40) :: mod = "ocean_model_flux_init" ! This module's name. - + character(len=40) :: mdl = "ocean_model_flux_init" ! This module's name. type(param_file_type) :: param_file !< A structure to parse for run-time parameters type(directories) :: dirs_tmp ! A structure containing several relevant directory paths. logical :: use_OCMIP_CFCs, use_MOM_generic_tracer + logical :: OS_is_set + + OS_is_set = .false. ; if (present(OS)) OS_is_set = associated(OS) call get_MOM_Input(param_file, dirs_tmp, check_params=.false.) - call get_param(param_file, mod, "USE_OCMIP2_CFC", use_OCMIP_CFCs, & - default=.false.) - call get_param(param_file, mod, "USE_generic_tracer", use_MOM_generic_tracer,& - default=.false.) + call get_param(param_file, mdl, "USE_OCMIP2_CFC", use_OCMIP_CFCs, & + default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_generic_tracer", use_MOM_generic_tracer,& + default=.false., do_not_log=.true.) call close_param_file(param_file, quiet_close=.true.) - if(.not.associated(OS)) then + if(.not.OS_is_set) then if (use_OCMIP_CFCs)then default_ice_restart_file = 'ice_ocmip2_cfc.res.nc' default_ocean_restart_file = 'ocmip2_cfc.res.nc' @@ -919,7 +922,7 @@ subroutine ocean_model_flux_init(OS) if (use_MOM_generic_tracer) then #ifdef _USE_GENERIC_TRACER - call MOM_generic_flux_init + call MOM_generic_flux_init() #else call MOM_error(FATAL, & "call_tracer_register: use_MOM_generic_tracer=.true. BUT not compiled with _USE_GENERIC_TRACER") diff --git a/config_src/ice_solo_driver/MOM_surface_forcing.F90 b/config_src/ice_solo_driver/MOM_surface_forcing.F90 index ba1cb445d4..3dec38024f 100644 --- a/config_src/ice_solo_driver/MOM_surface_forcing.F90 +++ b/config_src/ice_solo_driver/MOM_surface_forcing.F90 @@ -1113,7 +1113,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) type(time_type) :: Time_frc ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=60) :: axis_units character(len=200) :: filename, gust_file ! The name of the gustiness input file. @@ -1131,128 +1131,128 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, & + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & default=".") CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mod, "ADIABATIC", CS%adiabatic, & + call get_param(param_file, mdl, "ADIABATIC", CS%adiabatic, & "There are no diapycnal mass fluxes if ADIABATIC is \n"//& "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& "faster by eliminating subroutine calls.", default=.false.) - call get_param(param_file, mod, "VARIABLE_WINDS", CS%variable_winds, & + call get_param(param_file, mdl, "VARIABLE_WINDS", CS%variable_winds, & "If true, the winds vary in time after the initialization.", & default=.true.) - call get_param(param_file, mod, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & + call get_param(param_file, mdl, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & "If true, the buoyancy forcing varies in time after the \n"//& "initialization of the model.", default=.true.) - call get_param(param_file, mod, "BUOY_CONFIG", CS%buoy_config, & + call get_param(param_file, mdl, "BUOY_CONFIG", CS%buoy_config, & "The character string that indicates how buoyancy forcing \n"//& "is specified. Valid options include (file), (zero), \n"//& "(linear), (USER), and (NONE).", fail_if_missing=.true.) if (trim(CS%buoy_config) == "file") then - call get_param(param_file, mod, "LONGWAVEDOWN_FILE", CS%longwavedown_file, & + call get_param(param_file, mdl, "LONGWAVEDOWN_FILE", CS%longwavedown_file, & "The file with the downward longwave heat flux, in \n"//& "variable lwdn_sfc.", fail_if_missing=.true.) - call get_param(param_file, mod, "LONGWAVEUP_FILE", CS%longwaveup_file, & + call get_param(param_file, mdl, "LONGWAVEUP_FILE", CS%longwaveup_file, & "The file with the upward longwave heat flux, in \n"//& "variable lwup_sfc.", fail_if_missing=.true.) - call get_param(param_file, mod, "EVAPORATION_FILE", CS%evaporation_file, & + call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & "The file with the evaporative moisture flux, in \n"//& "variable evap.", fail_if_missing=.true.) - call get_param(param_file, mod, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & + call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & "The file with the sensible heat flux, in \n"//& "variable shflx.", fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & + call get_param(param_file, mdl, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & "The file with the upward shortwave heat flux.", & fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVEDOWN_FILE", CS%shortwavedown_file, & + call get_param(param_file, mdl, "SHORTWAVEDOWN_FILE", CS%shortwavedown_file, & "The file with the downward shortwave heat flux.", & fail_if_missing=.true.) - call get_param(param_file, mod, "SNOW_FILE", CS%snow_file, & + call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & "The file with the downward frozen precip flux, in \n"//& "variable snow.", fail_if_missing=.true.) - call get_param(param_file, mod, "PRECIP_FILE", CS%precip_file, & + call get_param(param_file, mdl, "PRECIP_FILE", CS%precip_file, & "The file with the downward total precip flux, in \n"//& "variable precip.", fail_if_missing=.true.) - call get_param(param_file, mod, "FRESHDISCHARGE_FILE", CS%freshdischarge_file, & + call get_param(param_file, mdl, "FRESHDISCHARGE_FILE", CS%freshdischarge_file, & "The file with the fresh and frozen runoff/calving fluxes, \n"//& "invariables disch_w and disch_s.", fail_if_missing=.true.) - call get_param(param_file, mod, "SSTRESTORE_FILE", CS%SSTrestore_file, & + call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & "The file with the SST toward which to restore in \n"//& "variable TEMP.", fail_if_missing=.true.) - call get_param(param_file, mod, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & + call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & "The file with the surface salinity toward which to \n"//& "restore in variable SALT.", fail_if_missing=.true.) endif - call get_param(param_file, mod, "WIND_CONFIG", CS%wind_config, & + call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & "The character string that indicates how wind forcing \n"//& "is specified. Valid options include (file), (2gyre), \n"//& "(1gyre), (gyres), (zero), and (USER).", fail_if_missing=.true.) if (trim(CS%wind_config) == "file") then - call get_param(param_file, mod, "WIND_FILE", CS%wind_file, & + call get_param(param_file, mdl, "WIND_FILE", CS%wind_file, & "The file in which the wind stresses are found in \n"//& "variables STRESS_X and STRESS_Y.", fail_if_missing=.true.) - call get_param(param_file, mod, "WINDSTRESS_X_VAR",CS%stress_x_var, & + call get_param(param_file, mdl, "WINDSTRESS_X_VAR",CS%stress_x_var, & "The name of the x-wind stress variable in WIND_FILE.", & default="STRESS_X") - call get_param(param_file, mod, "WINDSTRESS_Y_VAR", CS%stress_y_var, & + call get_param(param_file, mdl, "WINDSTRESS_Y_VAR", CS%stress_y_var, & "The name of the y-wind stress variable in WIND_FILE.", & default="STRESS_Y") - call get_param(param_file, mod, "WINDSTRESS_STAGGER",CS%wind_stagger, & + call get_param(param_file, mdl, "WINDSTRESS_STAGGER",CS%wind_stagger, & "A character indicating how the wind stress components \n"//& "are staggered in WIND_FILE. This may be A or C for now.", & default="A") - call get_param(param_file, mod, "WINDSTRESS_SCALE", CS%wind_scale, & + call get_param(param_file, mdl, "WINDSTRESS_SCALE", CS%wind_scale, & "A value by which the wind stresses in WIND_FILE are rescaled.", & default=1.0, units="nondim") endif if (trim(CS%wind_config) == "gyres") then - call get_param(param_file, mod, "TAUX_CONST", CS%gyres_taux_const, & + call get_param(param_file, mdl, "TAUX_CONST", CS%gyres_taux_const, & "With the gyres wind_config, the constant offset in the \n"//& "zonal wind stress profile: \n"//& " A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & + call get_param(param_file, mdl, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & "With the gyres wind_config, the sine amplitude in the \n"//& "zonal wind stress profile: \n"//& " B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & + call get_param(param_file, mdl, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & "With the gyres wind_config, the cosine amplitude in \n"//& "the zonal wind stress profile: \n"//& " C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_N_PIS",CS%gyres_taux_n_pis, & + call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & "With the gyres wind_config, the number of gyres in \n"//& "the zonal wind stress profile: \n"//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="nondim", default=0.0) endif - call get_param(param_file, mod, "SOUTHLAT", CS%south_lat, & + call get_param(param_file, mdl, "SOUTHLAT", CS%south_lat, & "The southern latitude of the domain or the equivalent \n"//& "starting value for the y-axis.", units=axis_units, default=0.) - call get_param(param_file, mod, "LENLAT", CS%len_lat, & + call get_param(param_file, mdl, "LENLAT", CS%len_lat, & "The latitudinal or y-direction length of the domain.", & units=axis_units, fail_if_missing=.true.) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & @@ -1260,36 +1260,36 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 if (trim(CS%buoy_config) == "linear") then - call get_param(param_file, mod, "SST_NORTH", CS%T_north, & + call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & "With buoy_config linear, the sea surface temperature \n"//& "at the northern end of the domain toward which to \n"//& "to restore.", units="deg C", default=0.0) - call get_param(param_file, mod, "SST_SOUTH", CS%T_south, & + call get_param(param_file, mdl, "SST_SOUTH", CS%T_south, & "With buoy_config linear, the sea surface temperature \n"//& "at the southern end of the domain toward which to \n"//& "to restore.", units="deg C", default=0.0) - call get_param(param_file, mod, "SSS_NORTH", CS%S_north, & + call get_param(param_file, mdl, "SSS_NORTH", CS%S_north, & "With buoy_config linear, the sea surface salinity \n"//& "at the northern end of the domain toward which to \n"//& "to restore.", units="PSU", default=35.0) - call get_param(param_file, mod, "SSS_SOUTH", CS%S_south, & + call get_param(param_file, mdl, "SSS_SOUTH", CS%S_south, & "With buoy_config linear, the sea surface salinity \n"//& "at the southern end of the domain toward which to \n"//& "to restore.", units="PSU", default=35.0) endif endif - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "READ_GUST_2D", CS%read_gust_2d, & + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from \n"//& "an input file", default=.false.) if (CS%read_gust_2d) then - call get_param(param_file, mod, "GUST_2D_FILE", gust_file, & + call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in \n"//& "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) ; CS%gust(:,:) = 0.0 @@ -1297,7 +1297,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) call read_data(filename,'gustiness',CS%gust,domain=G%domain%mpp_domain, & timelevel=1) ! units should be Pa endif - call get_param(param_file, mod, "AXIS_UNITS", axis_units, default="degrees") + call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") ! All parameter settings are now known. diff --git a/config_src/ice_solo_driver/ice_shelf_driver.F90 b/config_src/ice_solo_driver/ice_shelf_driver.F90 index a97803d7d6..426c5c4797 100644 --- a/config_src/ice_solo_driver/ice_shelf_driver.F90 +++ b/config_src/ice_solo_driver/ice_shelf_driver.F90 @@ -54,13 +54,15 @@ program SHELF_main use MOM_restart, only : save_restart ! use MOM_sum_output, only : write_energy, accumulate_net_input ! use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS + use MOM_string_functions, only : uppercase ! use MOM_surface_forcing, only : set_forcing, average_forcing ! use MOM_surface_forcing, only : surface_forcing_init, surface_forcing_CS use MOM_time_manager, only : time_type, set_date, set_time, get_date, time_type_to_real use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name - use MOM_time_manager, only : JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS + use MOM_time_manager, only : NO_CALENDAR use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init use MOM_write_cputime, only : write_cputime_start_clock, write_cputime_CS @@ -159,7 +161,7 @@ program SHELF_main character(len=4), parameter :: vers_num = 'v2.0' ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "SHELF_main (ice_shelf_driver)" ! This module's name. + character(len=40) :: mdl = "SHELF_main (ice_shelf_driver)" ! This module's name. namelist /ice_solo_nml/ date_init, calendar, months, days, hours, minutes, seconds @@ -197,12 +199,14 @@ program SHELF_main read(unit,*) date call close_file(unit) else - if (calendar(1:6) == 'julian') then ; calendar_type = JULIAN + calendar = uppercase(calendar) + if (calendar(1:6) == 'JULIAN') then ; calendar_type = JULIAN + else if (calendar(1:9) == 'GREGORIAN') then ; calendar_type = GREGORIAN else if (calendar(1:6) == 'NOLEAP') then ; calendar_type = NOLEAP - else if (calendar(1:10)=='thirty_day') then ; calendar_type = THIRTY_DAY_MONTHS - else if (calendar(1:11)=='no_calendar') then; calendar_type = NO_CALENDAR + else if (calendar(1:10)=='THIRTY_DAY') then ; calendar_type = THIRTY_DAY_MONTHS + else if (calendar(1:11)=='NO_CALENDAR') then; calendar_type = NO_CALENDAR else if (calendar(1:1) /= ' ') then - call MOM_error(FATAL,'MOM_driver: Invalid namelist value for calendar') + call MOM_error(FATAL,'MOM_driver: Invalid namelist value '//trim(calendar)//' for calendar') else call MOM_error(FATAL,'MOM_driver: No namelist value for calendar') endif @@ -219,16 +223,16 @@ program SHELF_main call Get_MOM_Input(param_file, dirs) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "ICE_SHELF", use_ice_shelf, & + call get_param(param_file, mdl, "ICE_SHELF", use_ice_shelf, & "If true, call the code to apply an ice shelf model over \n"//& "some of the domain.", default=.false.) if (.not.use_ice_shelf) call MOM_error(FATAL, & "shelf_driver: ICE_SHELF must be defined.") - call get_param(param_file, mod, "ICE_VELOCITY_TIMESTEP", time_step, & + call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics.", & units="s", fail_if_missing=.true.) @@ -256,20 +260,20 @@ program SHELF_main call MOM_mesg("Using real elapsed time for the master clock.") ! Determine the segment end time, either from the namelist file or parsed input file. - call get_param(param_file, mod, "TIMEUNIT", Time_unit, & + call get_param(param_file, mdl, "TIMEUNIT", Time_unit, & "The time unit for DAYMAX and RESTINT.", & units="s", default=86400.0) if (years+months+days+hours+minutes+seconds > 0) then Time_end = increment_date(Time, years, months, days, hours, minutes, seconds) call MOM_mesg('Segment run length determied from ice_solo_nml.', 2) - call get_param(param_file, mod, "DAYMAX", daymax, & + call get_param(param_file, mdl, "DAYMAX", daymax, & "The final time of the whole simulation, in units of \n"//& "TIMEUNIT seconds. This also sets the potential end \n"//& "time of the present run segment if the end time is \n"//& "not set (as it was here) via ocean_solo_nml in input.nml.", & timeunit=Time_unit, default=Time_end) else - call get_param(param_file, mod, "DAYMAX", daymax, & + call get_param(param_file, mdl, "DAYMAX", daymax, & "The final time of the whole simulation, in units of \n"//& "TIMEUNIT seconds. This also sets the potential end \n"//& "time of the present run segment if the end time is \n"//& @@ -282,18 +286,18 @@ program SHELF_main if (Time >= Time_end) call MOM_error(FATAL, & "MOM_driver: The run has been started at or after the end time of the run.") - call get_param(param_file, mod, "RESTART_CONTROL", Restart_control, & + call get_param(param_file, mdl, "RESTART_CONTROL", Restart_control, & "An integer whose bits encode which restart files are \n"//& "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& "(bit 0) for a non-time-stamped file. A non-time-stamped \n"//& "restart file is saved at the end of the run segment \n"//& "for any non-negative value.", default=1) - call get_param(param_file, mod, "RESTINT", restint, & + call get_param(param_file, mdl, "RESTINT", restint, & "The interval between saves of the restart file in units \n"//& "of TIMEUNIT. Use 0 (the default) to not save \n"//& "incremental restart files at all.", default=set_time(0), & timeunit=Time_unit) - call log_param(param_file, mod, "ELAPSED TIME AS MASTER", elapsed_time_master) + call log_param(param_file, mdl, "ELAPSED TIME AS MASTER", elapsed_time_master) ! i don't think we'll use this... ! call MOM_sum_output_init(grid, param_file, dirs%output_directory, & diff --git a/config_src/ice_solo_driver/user_surface_forcing.F90 b/config_src/ice_solo_driver/user_surface_forcing.F90 index bc056a129c..4ffb2a3668 100644 --- a/config_src/ice_solo_driver/user_surface_forcing.F90 +++ b/config_src/ice_solo_driver/user_surface_forcing.F90 @@ -332,7 +332,7 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "user_surface_forcing" ! This module's name. + character(len=40) :: mdl = "user_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "USER_surface_forcing_init called with an associated "// & @@ -343,28 +343,28 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file,mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/config_src/solo_driver/MESO_surface_forcing.F90 b/config_src/solo_driver/MESO_surface_forcing.F90 index 8ab8ece60c..c479dafc97 100644 --- a/config_src/solo_driver/MESO_surface_forcing.F90 +++ b/config_src/solo_driver/MESO_surface_forcing.F90 @@ -364,7 +364,7 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MESO_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MESO_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "MESO_surface_forcing_init called with an associated "// & @@ -375,31 +375,31 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & @@ -407,22 +407,22 @@ subroutine MESO_surface_forcing_init(Time, G, param_file, diag, CS) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 - call get_param(param_file, mod, "SSTRESTORE_FILE", CS%SSTrestore_file, & + call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & "The file with the SST toward which to restore in \n"//& "variable TEMP.", fail_if_missing=.true.) - call get_param(param_file, mod, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & + call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & "The file with the surface salinity toward which to \n"//& "restore in variable SALT.", fail_if_missing=.true.) - call get_param(param_file, mod, "SENSIBLEHEAT_FILE", CS%heating_file, & + call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%heating_file, & "The file with the non-shortwave heat flux in \n"//& "variable Heat.", fail_if_missing=.true.) - call get_param(param_file, mod, "PRECIP_FILE", CS%PmE_file, & + call get_param(param_file, mdl, "PRECIP_FILE", CS%PmE_file, & "The file with the net precipiation minus evaporation \n"//& "in variable PmE.", fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVE_FILE", CS%Solar_file, & + call get_param(param_file, mdl, "SHORTWAVE_FILE", CS%Solar_file, & "The file with the shortwave heat flux in \n"//& "variable NET_SOL.", fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) endif diff --git a/config_src/solo_driver/MOM_driver.F90 b/config_src/solo_driver/MOM_driver.F90 index 32917d2921..befc4cf310 100644 --- a/config_src/solo_driver/MOM_driver.F90 +++ b/config_src/solo_driver/MOM_driver.F90 @@ -47,7 +47,7 @@ program MOM_main use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : calculate_surface_state, finish_MOM_initialization - use MOM, only : step_tracers + use MOM, only : step_offline use MOM_domains, only : MOM_infra_init, MOM_infra_end use MOM_error_handler, only : MOM_error, MOM_mesg, WARNING, FATAL, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -60,6 +60,7 @@ program MOM_main use MOM_io, only : check_nml_error, io_infra_init, io_infra_end use MOM_io, only : APPEND_FILE, ASCII_FILE, READONLY_FILE, SINGLE_FILE use MOM_restart, only : save_restart + use MOM_string_functions, only : uppercase use MOM_sum_output, only : write_energy, accumulate_net_input use MOM_sum_output, only : MOM_sum_output_init, sum_output_CS use MOM_surface_forcing, only : set_forcing, forcing_save_restart @@ -68,7 +69,8 @@ program MOM_main use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) use MOM_time_manager, only : operator(>), operator(<), operator(>=) use MOM_time_manager, only : increment_date, set_calendar_type, month_name - use MOM_time_manager, only : JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR + use MOM_time_manager, only : JULIAN, GREGORIAN, NOLEAP, THIRTY_DAY_MONTHS + use MOM_time_manager, only : NO_CALENDAR use MOM_variables, only : surface use MOM_verticalGrid, only : verticalGrid_type use MOM_write_cputime, only : write_cputime, MOM_write_cputime_init @@ -189,7 +191,7 @@ program MOM_main character(len=4), parameter :: vers_num = 'v2.0' ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_main (MOM_driver)" ! This module's name. + character(len=40) :: mod_name = "MOM_main (MOM_driver)" ! This module's name. integer :: ocean_nthreads = 1 integer :: ncores_per_node = 36 @@ -241,7 +243,7 @@ program MOM_main !$OMP PARALLEL private(adder) !$ base_cpu = get_cpu_affinity() !$ if (use_hyper_thread) then -!$ if (imod(omp_get_thread_num(),2) == 0) then +!$ if (mod(omp_get_thread_num(),2) == 0) then !$ adder = omp_get_thread_num()/2 !$ else !$ adder = ncores_per_node + omp_get_thread_num()/2 @@ -263,12 +265,14 @@ program MOM_main read(unit,*) date call close_file(unit) else - if (calendar(1:6) == 'julian') then ; calendar_type = JULIAN + calendar = uppercase(calendar) + if (calendar(1:6) == 'JULIAN') then ; calendar_type = JULIAN + else if (calendar(1:9) == 'GREGORIAN') then ; calendar_type = GREGORIAN else if (calendar(1:6) == 'NOLEAP') then ; calendar_type = NOLEAP - else if (calendar(1:10)=='thirty_day') then ; calendar_type = THIRTY_DAY_MONTHS - else if (calendar(1:11)=='no_calendar') then; calendar_type = NO_CALENDAR + else if (calendar(1:10)=='THIRTY_DAY') then ; calendar_type = THIRTY_DAY_MONTHS + else if (calendar(1:11)=='NO_CALENDAR') then; calendar_type = NO_CALENDAR else if (calendar(1:1) /= ' ') then - call MOM_error(FATAL,'MOM_driver: Invalid namelist value for calendar') + call MOM_error(FATAL,'MOM_driver: Invalid namelist value '//trim(calendar)//' for calendar') else call MOM_error(FATAL,'MOM_driver: No namelist value for calendar') endif @@ -308,7 +312,7 @@ program MOM_main surface_forcing_CSp, MOM_CSp%tracer_flow_CSp) call callTree_waypoint("done surface_forcing_init") - call get_param(param_file, mod, "ICE_SHELF", use_ice_shelf, & + call get_param(param_file, mod_name, "ICE_SHELF", use_ice_shelf, & "If true, enables the ice shelf model.", default=.false.) if (use_ice_shelf) then ! These arrays are not initialized in most solo cases, but are needed @@ -326,14 +330,14 @@ program MOM_main elapsed_time = 0.0 ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DT", dt, fail_if_missing=.true.) - call get_param(param_file, mod, "DT_FORCING", time_step, & + call log_version(param_file, mod_name, version, "") + call get_param(param_file, mod_name, "DT", dt, fail_if_missing=.true.) + call get_param(param_file, mod_name, "DT_FORCING", time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=dt) if (offline_tracer_mode) then - call get_param(param_file, mod, "DT_OFFLINE", time_step, & + call get_param(param_file, mod_name, "DT_OFFLINE", time_step, & "Time step for the offline time step") dt = time_step endif @@ -345,22 +349,22 @@ program MOM_main call MOM_mesg("Using real elapsed time for the master clock.", 2) ! Determine the segment end time, either from the namelist file or parsed input file. - call get_param(param_file, mod, "TIMEUNIT", Time_unit, & + call get_param(param_file, mod_name, "TIMEUNIT", Time_unit, & "The time unit for DAYMAX, ENERGYSAVEDAYS, and RESTINT.", & units="s", default=86400.0) if (years+months+days+hours+minutes+seconds > 0) then Time_end = increment_date(Time, years, months, days, hours, minutes, seconds) call MOM_mesg('Segment run length determined from ocean_solo_nml.', 2) - call get_param(param_file, mod, "DAYMAX", daymax, timeunit=Time_unit, & + call get_param(param_file, mod_name, "DAYMAX", daymax, timeunit=Time_unit, & default=Time_end, do_not_log=.true.) - call log_param(param_file, mod, "DAYMAX", daymax, & + call log_param(param_file, mod_name, "DAYMAX", daymax, & "The final time of the whole simulation, in units of \n"//& "TIMEUNIT seconds. This also sets the potential end \n"//& "time of the present run segment if the end time is \n"//& "not set via ocean_solo_nml in input.nml.", & timeunit=Time_unit) else - call get_param(param_file, mod, "DAYMAX", daymax, & + call get_param(param_file, mod_name, "DAYMAX", daymax, & "The final time of the whole simulation, in units of \n"//& "TIMEUNIT seconds. This also sets the potential end \n"//& "time of the present run segment if the end time is \n"//& @@ -372,23 +376,23 @@ program MOM_main if (Time >= Time_end) call MOM_error(FATAL, & "MOM_driver: The run has been started at or after the end time of the run.") - call get_param(param_file, mod, "RESTART_CONTROL", Restart_control, & + call get_param(param_file, mod_name, "RESTART_CONTROL", Restart_control, & "An integer whose bits encode which restart files are \n"//& "written. Add 2 (bit 1) for a time-stamped file, and odd \n"//& "(bit 0) for a non-time-stamped file. A non-time-stamped \n"//& "restart file is saved at the end of the run segment \n"//& "for any non-negative value.", default=1) - call get_param(param_file, mod, "RESTINT", restint, & + call get_param(param_file, mod_name, "RESTINT", restint, & "The interval between saves of the restart file in units \n"//& "of TIMEUNIT. Use 0 (the default) to not save \n"//& "incremental restart files at all.", default=set_time(0), & timeunit=Time_unit) - call get_param(param_file, mod, "ENERGYSAVEDAYS", energysavedays, & + call get_param(param_file, mod_name, "ENERGYSAVEDAYS", energysavedays, & "The interval in units of TIMEUNIT between saves of the \n"//& "energies of the run and other globally summed diagnostics.", & default=set_time(int(time_step+0.5)), timeunit=Time_unit) - call log_param(param_file, mod, "ELAPSED TIME AS MASTER", elapsed_time_master) + call log_param(param_file, mod_name, "ELAPSED TIME AS MASTER", elapsed_time_master) ! Close the param_file. No further parsing of input is possible after this. call close_param_file(param_file) @@ -464,7 +468,7 @@ program MOM_main ! This call steps the model over a time time_step. Time1 = Master_Time ; Time = Master_Time if (offline_tracer_mode) then - call step_tracers(fluxes, state, Time1, time_step, MOM_CSp) + call step_offline(fluxes, state, Time1, time_step, MOM_CSp) else call step_MOM(fluxes, state, Time1, time_step, MOM_CSp) endif diff --git a/config_src/solo_driver/MOM_surface_forcing.F90 b/config_src/solo_driver/MOM_surface_forcing.F90 index 10ea344e16..6a9c60e49a 100644 --- a/config_src/solo_driver/MOM_surface_forcing.F90 +++ b/config_src/solo_driver/MOM_surface_forcing.F90 @@ -1535,7 +1535,7 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) type(time_type) :: Time_frc ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_surface_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=200) :: filename, gust_file ! The name of the gustiness input file. if (associated(CS)) then @@ -1552,63 +1552,63 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) if (associated(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, '') - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, '') + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, & + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, & "The directory in which all input files are found.", & default=".") CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mod, "ADIABATIC", CS%adiabatic, & + call get_param(param_file, mdl, "ADIABATIC", CS%adiabatic, & "There are no diapycnal mass fluxes if ADIABATIC is \n"//& "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& "faster by eliminating subroutine calls.", default=.false.) - call get_param(param_file, mod, "VARIABLE_WINDS", CS%variable_winds, & + call get_param(param_file, mdl, "VARIABLE_WINDS", CS%variable_winds, & "If true, the winds vary in time after the initialization.", & default=.true.) - call get_param(param_file, mod, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & + call get_param(param_file, mdl, "VARIABLE_BUOYFORCE", CS%variable_buoyforce, & "If true, the buoyancy forcing varies in time after the \n"//& "initialization of the model.", default=.true.) - call get_param(param_file, mod, "BUOY_CONFIG", CS%buoy_config, & + call get_param(param_file, mdl, "BUOY_CONFIG", CS%buoy_config, & "The character string that indicates how buoyancy forcing \n"//& "is specified. Valid options include (file), (zero), \n"//& "(linear), (USER), (BFB) and (NONE).", fail_if_missing=.true.) if (trim(CS%buoy_config) == "file") then - call get_param(param_file, mod, "ARCHAIC_OMIP_FORCING_FILE", CS%archaic_OMIP_file, & + call get_param(param_file, mdl, "ARCHAIC_OMIP_FORCING_FILE", CS%archaic_OMIP_file, & "If true, use the forcing variable decomposition from \n"//& "the old German OMIP prescription that predated CORE. If \n"//& "false, use the variable groupings available from MOM \n"//& "output diagnostics of forcing variables.", default=.true.) if (CS%archaic_OMIP_file) then - call get_param(param_file, mod, "LONGWAVEDOWN_FILE", CS%longwave_file, & + call get_param(param_file, mdl, "LONGWAVEDOWN_FILE", CS%longwave_file, & "The file with the downward longwave heat flux, in \n"//& "variable lwdn_sfc.", fail_if_missing=.true.) - call get_param(param_file, mod, "LONGWAVEUP_FILE", CS%longwaveup_file, & + call get_param(param_file, mdl, "LONGWAVEUP_FILE", CS%longwaveup_file, & "The file with the upward longwave heat flux, in \n"//& "variable lwup_sfc.", fail_if_missing=.true.) - call get_param(param_file, mod, "EVAPORATION_FILE", CS%evaporation_file, & + call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & "The file with the evaporative moisture flux, in \n"//& "variable evap.", fail_if_missing=.true.) - call get_param(param_file, mod, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & + call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & "The file with the sensible heat flux, in \n"//& "variable shflx.", fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & + call get_param(param_file, mdl, "SHORTWAVEUP_FILE", CS%shortwaveup_file, & "The file with the upward shortwave heat flux.", & fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVEDOWN_FILE", CS%shortwave_file, & + call get_param(param_file, mdl, "SHORTWAVEDOWN_FILE", CS%shortwave_file, & "The file with the downward shortwave heat flux.", & fail_if_missing=.true.) - call get_param(param_file, mod, "SNOW_FILE", CS%snow_file, & + call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & "The file with the downward frozen precip flux, in \n"//& "variable snow.", fail_if_missing=.true.) - call get_param(param_file, mod, "PRECIP_FILE", CS%rain_file, & + call get_param(param_file, mdl, "PRECIP_FILE", CS%rain_file, & "The file with the downward total precip flux, in \n"//& "variable precip.", fail_if_missing=.true.) - call get_param(param_file, mod, "FRESHDISCHARGE_FILE", CS%runoff_file, & + call get_param(param_file, mdl, "FRESHDISCHARGE_FILE", CS%runoff_file, & "The file with the fresh and frozen runoff/calving fluxes, \n"//& "invariables disch_w and disch_s.", fail_if_missing=.true.) @@ -1619,66 +1619,66 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) CS%lrunoff_var = "disch_w"; CS%frunoff_var = "disch_s" else - call get_param(param_file, mod, "LONGWAVE_FILE", CS%longwave_file, & + call get_param(param_file, mdl, "LONGWAVE_FILE", CS%longwave_file, & "The file with the longwave heat flux, in the variable \n"//& "given by LONGWAVE_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "LONGWAVE_FORCING_VAR", CS%LW_var, & + call get_param(param_file, mdl, "LONGWAVE_FORCING_VAR", CS%LW_var, & "The variable with the longwave forcing field.", default="LW") - call get_param(param_file, mod, "SHORTWAVE_FILE", CS%shortwave_file, & + call get_param(param_file, mdl, "SHORTWAVE_FILE", CS%shortwave_file, & "The file with the shortwave heat flux, in the variable \n"//& "given by SHORTWAVE_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "SHORTWAVE_FORCING_VAR", CS%SW_var, & + call get_param(param_file, mdl, "SHORTWAVE_FORCING_VAR", CS%SW_var, & "The variable with the shortwave forcing field.", default="SW") - call get_param(param_file, mod, "EVAPORATION_FILE", CS%evaporation_file, & + call get_param(param_file, mdl, "EVAPORATION_FILE", CS%evaporation_file, & "The file with the evaporative moisture flux, in the \n"//& "variable given by EVAP_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "EVAP_FORCING_VAR", CS%evap_var, & + call get_param(param_file, mdl, "EVAP_FORCING_VAR", CS%evap_var, & "The variable with the evaporative moisture flux.", & default="evap") - call get_param(param_file, mod, "LATENTHEAT_FILE", CS%latentheat_file, & + call get_param(param_file, mdl, "LATENTHEAT_FILE", CS%latentheat_file, & "The file with the latent heat flux, in the variable \n"//& "given by LATENT_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "LATENT_FORCING_VAR", CS%latent_var, & + call get_param(param_file, mdl, "LATENT_FORCING_VAR", CS%latent_var, & "The variable with the latent heat flux.", default="latent") - call get_param(param_file, mod, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & + call get_param(param_file, mdl, "SENSIBLEHEAT_FILE", CS%sensibleheat_file, & "The file with the sensible heat flux, in the variable \n"//& "given by SENSIBLE_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "SENSIBLE_FORCING_VAR", CS%sens_var, & + call get_param(param_file, mdl, "SENSIBLE_FORCING_VAR", CS%sens_var, & "The variable with the sensible heat flux.", default="sensible") - call get_param(param_file, mod, "RAIN_FILE", CS%rain_file, & + call get_param(param_file, mdl, "RAIN_FILE", CS%rain_file, & "The file with the liquid precipitation flux, in the \n"//& "variable given by RAIN_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "RAIN_FORCING_VAR", CS%rain_var, & + call get_param(param_file, mdl, "RAIN_FORCING_VAR", CS%rain_var, & "The variable with the liquid precipitation flux.", & default="liq_precip") - call get_param(param_file, mod, "SNOW_FILE", CS%snow_file, & + call get_param(param_file, mdl, "SNOW_FILE", CS%snow_file, & "The file with the frozen precipitation flux, in the \n"//& "variable given by SNOW_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "SNOW_FORCING_VAR", CS%snow_var, & + call get_param(param_file, mdl, "SNOW_FORCING_VAR", CS%snow_var, & "The variable with the frozen precipitation flux.", & default="froz_precip") - call get_param(param_file, mod, "RUNOFF_FILE", CS%runoff_file, & + call get_param(param_file, mdl, "RUNOFF_FILE", CS%runoff_file, & "The file with the fresh and frozen runoff/calving \n"//& "fluxes, in variables given by LIQ_RUNOFF_FORCING_VAR \n"//& "and FROZ_RUNOFF_FORCING_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "LIQ_RUNOFF_FORCING_VAR", CS%lrunoff_var, & + call get_param(param_file, mdl, "LIQ_RUNOFF_FORCING_VAR", CS%lrunoff_var, & "The variable with the liquid runoff flux.", & default="liq_runoff") - call get_param(param_file, mod, "FROZ_RUNOFF_FORCING_VAR", CS%frunoff_var, & + call get_param(param_file, mdl, "FROZ_RUNOFF_FORCING_VAR", CS%frunoff_var, & "The variable with the frozen runoff flux.", & default="froz_runoff") endif - call get_param(param_file, mod, "SSTRESTORE_FILE", CS%SSTrestore_file, & + call get_param(param_file, mdl, "SSTRESTORE_FILE", CS%SSTrestore_file, & "The file with the SST toward which to restore in the \n"//& "variable given by SST_RESTORE_VAR.", fail_if_missing=.true.) - call get_param(param_file, mod, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & + call get_param(param_file, mdl, "SALINITYRESTORE_FILE", CS%salinityrestore_file, & "The file with the surface salinity toward which to \n"//& "restore in the variable given by SSS_RESTORE_VAR.", & fail_if_missing=.true.) @@ -1686,10 +1686,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) if (CS%archaic_OMIP_file) then CS%SST_restore_var = "TEMP" ; CS%SSS_restore_var = "SALT" else - call get_param(param_file, mod, "SST_RESTORE_VAR", CS%SST_restore_var, & + call get_param(param_file, mdl, "SST_RESTORE_VAR", CS%SST_restore_var, & "The variable with the SST toward which to restore.", & default="SST") - call get_param(param_file, mod, "SSS_RESTORE_VAR", CS%SSS_restore_var, & + call get_param(param_file, mdl, "SSS_RESTORE_VAR", CS%SSS_restore_var, & "The variable with the SSS toward which to restore.", & default="SSS") endif @@ -1710,55 +1710,55 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) CS%SSTrestore_file = trim(CS%inputdir)//trim(CS%SSTrestore_file) CS%salinityrestore_file = trim(CS%inputdir)//trim(CS%salinityrestore_file) elseif (trim(CS%buoy_config) == "const") then - call get_param(param_file, mod, "SENSIBLE_HEAT_FLUX", CS%constantHeatForcing, & + call get_param(param_file, mdl, "SENSIBLE_HEAT_FLUX", CS%constantHeatForcing, & "A constant heat forcing (positive into ocean) applied \n"//& "through the sensible heat flux field. ", & units='W/m2', fail_if_missing=.true.) endif - call get_param(param_file, mod, "WIND_CONFIG", CS%wind_config, & + call get_param(param_file, mdl, "WIND_CONFIG", CS%wind_config, & "The character string that indicates how wind forcing \n"//& "is specified. Valid options include (file), (2gyre), \n"//& "(1gyre), (gyres), (zero), and (USER).", fail_if_missing=.true.) if (trim(CS%wind_config) == "file") then - call get_param(param_file, mod, "WIND_FILE", CS%wind_file, & + call get_param(param_file, mdl, "WIND_FILE", CS%wind_file, & "The file in which the wind stresses are found in \n"//& "variables STRESS_X and STRESS_Y.", fail_if_missing=.true.) - call get_param(param_file, mod, "WINDSTRESS_X_VAR",CS%stress_x_var, & + call get_param(param_file, mdl, "WINDSTRESS_X_VAR",CS%stress_x_var, & "The name of the x-wind stress variable in WIND_FILE.", & default="STRESS_X") - call get_param(param_file, mod, "WINDSTRESS_Y_VAR", CS%stress_y_var, & + call get_param(param_file, mdl, "WINDSTRESS_Y_VAR", CS%stress_y_var, & "The name of the y-wind stress variable in WIND_FILE.", & default="STRESS_Y") - call get_param(param_file, mod, "WINDSTRESS_STAGGER",CS%wind_stagger, & + call get_param(param_file, mdl, "WINDSTRESS_STAGGER",CS%wind_stagger, & "A character indicating how the wind stress components \n"//& "are staggered in WIND_FILE. This may be A or C for now.", & default="A") - call get_param(param_file, mod, "WINDSTRESS_SCALE", CS%wind_scale, & + call get_param(param_file, mdl, "WINDSTRESS_SCALE", CS%wind_scale, & "A value by which the wind stresses in WIND_FILE are rescaled.", & default=1.0, units="nondim") - call get_param(param_file, mod, "USTAR_FORCING_VAR", CS%ustar_var, & + call get_param(param_file, mdl, "USTAR_FORCING_VAR", CS%ustar_var, & "The name of the friction velocity variable in WIND_FILE \n"//& "or blank to get ustar from the wind stresses plus the \n"//& "gustiness.", default=" ", units="nondim") CS%wind_file = trim(CS%inputdir) // trim(CS%wind_file) endif if (trim(CS%wind_config) == "gyres") then - call get_param(param_file, mod, "TAUX_CONST", CS%gyres_taux_const, & + call get_param(param_file, mdl, "TAUX_CONST", CS%gyres_taux_const, & "With the gyres wind_config, the constant offset in the \n"//& "zonal wind stress profile: \n"//& " A in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & + call get_param(param_file, mdl, "TAUX_SIN_AMP",CS%gyres_taux_sin_amp, & "With the gyres wind_config, the sine amplitude in the \n"//& "zonal wind stress profile: \n"//& " B in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & + call get_param(param_file, mdl, "TAUX_COS_AMP",CS%gyres_taux_cos_amp, & "With the gyres wind_config, the cosine amplitude in \n"//& "the zonal wind stress profile: \n"//& " C in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & units="Pa", default=0.0) - call get_param(param_file, mod, "TAUX_N_PIS",CS%gyres_taux_n_pis, & + call get_param(param_file, mdl, "TAUX_N_PIS",CS%gyres_taux_n_pis, & "With the gyres wind_config, the number of gyres in \n"//& "the zonal wind stress profile: \n"//& " n in taux = A + B*sin(n*pi*y/L) + C*cos(n*pi*y/L).", & @@ -1771,22 +1771,22 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) CS%south_lat = G%south_lat CS%len_lat = G%len_lat endif - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) - call get_param(param_file, mod, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & + call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mod, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & + call get_param(param_file, mdl, "LATENT_HEAT_VAPORIZATION", CS%latent_heat_vapor, & "The latent heat of fusion.", units="J/kg", default=hlv) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & @@ -1794,36 +1794,36 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) ! Convert CS%Flux_const from m day-1 to m s-1. CS%Flux_const = CS%Flux_const / 86400.0 if (trim(CS%buoy_config) == "linear") then - call get_param(param_file, mod, "SST_NORTH", CS%T_north, & + call get_param(param_file, mdl, "SST_NORTH", CS%T_north, & "With buoy_config linear, the sea surface temperature \n"//& "at the northern end of the domain toward which to \n"//& "to restore.", units="deg C", default=0.0) - call get_param(param_file, mod, "SST_SOUTH", CS%T_south, & + call get_param(param_file, mdl, "SST_SOUTH", CS%T_south, & "With buoy_config linear, the sea surface temperature \n"//& "at the southern end of the domain toward which to \n"//& "to restore.", units="deg C", default=0.0) - call get_param(param_file, mod, "SSS_NORTH", CS%S_north, & + call get_param(param_file, mdl, "SSS_NORTH", CS%S_north, & "With buoy_config linear, the sea surface salinity \n"//& "at the northern end of the domain toward which to \n"//& "to restore.", units="PSU", default=35.0) - call get_param(param_file, mod, "SSS_SOUTH", CS%S_south, & + call get_param(param_file, mdl, "SSS_SOUTH", CS%S_south, & "With buoy_config linear, the sea surface salinity \n"//& "at the southern end of the domain toward which to \n"//& "to restore.", units="PSU", default=35.0) endif endif - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "READ_GUST_2D", CS%read_gust_2d, & + call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & "If true, use a 2-dimensional gustiness supplied from \n"//& "an input file", default=.false.) if (CS%read_gust_2d) then - call get_param(param_file, mod, "GUST_2D_FILE", gust_file, & + call get_param(param_file, mdl, "GUST_2D_FILE", gust_file, & "The file in which the wind gustiness is found in \n"//& "variable gustiness.", fail_if_missing=.true.) call safe_alloc_ptr(CS%gust,G%isd,G%ied,G%jsd,G%jed) @@ -1843,10 +1843,10 @@ subroutine surface_forcing_init(Time, G, param_file, diag, CS, tracer_flow_CSp) elseif (trim(CS%wind_config) == "SCM_ideal_hurr") then call SCM_idealized_hurricane_wind_init(Time, G, param_file, CS%SCM_idealized_hurricane_CSp) elseif (trim(CS%wind_config) == "const") then - call get_param(param_file, mod, "CONST_WIND_TAUX", CS%tau_x0, & + call get_param(param_file, mdl, "CONST_WIND_TAUX", CS%tau_x0, & "With wind_config const, this is the constant zonal\n"//& "wind-stress", units="Pa", fail_if_missing=.true.) - call get_param(param_file, mod, "CONST_WIND_TAUY", CS%tau_y0, & + call get_param(param_file, mdl, "CONST_WIND_TAUY", CS%tau_y0, & "With wind_config const, this is the constant zonal\n"//& "wind-stress", units="Pa", fail_if_missing=.true.) elseif (trim(CS%wind_config) == "SCM_CVmix_tests" .or. & diff --git a/config_src/solo_driver/user_surface_forcing.F90 b/config_src/solo_driver/user_surface_forcing.F90 index acc5d24c78..6b18a2a234 100644 --- a/config_src/solo_driver/user_surface_forcing.F90 +++ b/config_src/solo_driver/user_surface_forcing.F90 @@ -332,7 +332,7 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "user_surface_forcing" ! This module's name. + character(len=40) :: mdl = "user_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "USER_surface_forcing_init called with an associated "// & @@ -343,30 +343,30 @@ subroutine USER_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/config_src/unit_drivers/MOM_sum_driver.F90 b/config_src/unit_drivers/MOM_sum_driver.F90 index 1be9af0d5c..d2099a5bc0 100644 --- a/config_src/unit_drivers/MOM_sum_driver.F90 +++ b/config_src/unit_drivers/MOM_sum_driver.F90 @@ -74,7 +74,7 @@ program MOM_main character(len=4), parameter :: vers_num = 'v2.0' ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_main (MOM_sum_driver)" ! This module's name. + character(len=40) :: mdl = "MOM_main (MOM_sum_driver)" ! This module's name. character(len=200) :: mesg !####################################################################### @@ -200,15 +200,15 @@ subroutine benchmark_init_topog_local(D, G, param_file, max_depth) real :: x, y ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "benchmark_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version) - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) PI = 4.0*atan(1.0) diff --git a/docs/images/Horizontal indexing in MOM6.ipynb b/docs/images/Horizontal indexing in MOM6.ipynb new file mode 100644 index 0000000000..4307c544f5 --- /dev/null +++ b/docs/images/Horizontal indexing in MOM6.ipynb @@ -0,0 +1,128 @@ +{ + "cells": [ + { + "cell_type": "markdown", + "metadata": {}, + "source": [ + "### Generates schematics of horizontal indexing conventions" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": { + "collapsed": true + }, + "outputs": [], + "source": [ + "import numpy, matplotlib.pyplot as plt\n", + "%matplotlib inline\n", + "plt.xkcd();" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "# Figure 1\n", + "def plot_grid(ni,nj,hi,hj,symmetric=True):\n", + " isc,jsc,iec,jec = 0.5,0.5,ni-.5,nj-.5\n", + " isd,jsd,ied,jed = isc-hi,jsc-hj,iec+hi,jec+hj\n", + " if symmetric:\n", + " IsdB,IedB,JsdB,JedB,IscB,IecB,JscB,JecB = isd-.5,ied+.5,jsd-.5,jed+.5,isc-.5,iec+.5,jsc-.5,jec+.5\n", + " else:\n", + " IsdB,IedB,JsdB,JedB,IscB,IecB,JscB,JecB = isd+.5,ied+.5,jsd+.5,jed+.5,isc+.5,iec+.5,jsc+.5,jec+.5\n", + " #XsdB,XedB,YsdB,YedB = isd-.5,ied+.5,jsd-.5,jed+.5\n", + " fig = plt.figure()\n", + " ax1 = fig.add_subplot(111)\n", + " ax2 = ax1.twiny()\n", + " ax3 = ax1.twinx()\n", + " for ax in [ax1,ax2,ax3]:\n", + " ax.set_xlim(isd-1,ied+1)\n", + " ax.set_ylim(jsd-1,ied+1)\n", + " # Halos of data domain\n", + " #for x in numpy.arange(IsdB,IedB+1): ax1.plot([x,x],[JsdB,JedB],'k')\n", + " for x in numpy.arange(IsdB,IscB): ax1.plot([x,x],[jsd-.5,JedB],'b')\n", + " for x in numpy.arange(IecB+1,IedB+1): ax1.plot([x,x],[jsd-.5,JedB],'b')\n", + " for x in numpy.arange(IscB,IecB+1):\n", + " ax1.plot([x,x],[jsd-.5,jsc-.5],'b')\n", + " ax1.plot([x,x],[JecB,JedB],'b')\n", + " #for y in numpy.arange(JsdB,JedB+1): ax1.plot([IsdB,IedB],[y,y],'k')\n", + " for y in numpy.arange(JsdB,JscB): ax1.plot([isd-.5,IedB],[y,y],'b')\n", + " for y in numpy.arange(JecB+1,JedB+1): ax1.plot([isd-.5,IedB],[y,y],'b')\n", + " for y in numpy.arange(JscB,JecB+1):\n", + " ax1.plot([isd-.5,isc-.5],[y,y],'b')\n", + " ax1.plot([IecB,IedB],[y,y],'b')\n", + " # Computational domain\n", + " for x in numpy.arange(IscB,IecB+1): ax2.plot([x,x],[jsc-.5,jec+.5],'r')\n", + " for y in numpy.arange(JscB,JecB+1): ax2.plot([isc-.5,iec+.5],[y,y],'r')\n", + " for y in numpy.arange(jsd,jed+1):\n", + " for x in numpy.arange(isd,ied+1):\n", + " ax2.plot(x,y,'xb')\n", + " for y in numpy.arange(jsc,jec+1):\n", + " for x in numpy.arange(isc,iec+1):\n", + " ax2.plot(x,y,'xr')\n", + " for y in numpy.arange(JsdB,JedB+1):\n", + " for x in numpy.arange(IsdB,IedB+1):\n", + " ax2.plot(x,y,'ob')\n", + " for y in numpy.arange(JscB,JecB+1):\n", + " for x in numpy.arange(IscB,IecB+1):\n", + " ax2.plot(x,y,'or')\n", + " text_opts={'horizontalalignment':'center','verticalalignment':'center','backgroundcolor':'w'}\n", + " ax1.set_xticks([IsdB,IscB,IecB,IedB])\n", + " ax1.set_xticklabels(['IsdB','IscB','IecB','IedB'])\n", + " ax1.set_yticks([JsdB,JscB,JecB,JedB])\n", + " ax1.set_yticklabels(['JsdB','JscB','JecB','JedB'])\n", + " ax1.set_xlabel('q-/u-point I')\n", + " ax1.set_ylabel('q-/v-point J')\n", + " ax2.set_xticks([isd,isc,iec,ied])\n", + " ax2.set_xticklabels(['isd','isc','iec','ied'])\n", + " ax2.set_xlabel('h-/v-point i')\n", + " ax3.set_yticks([jsd,jsc,jec,jed])\n", + " ax3.set_yticklabels(['jsd','jsc','jec','jed'])\n", + " ax3.set_ylabel('h-/u-point j')\n", + " for ax in [ax1,ax2,ax3]:\n", + " ax.spines['bottom'].set_visible(False)\n", + " ax.spines['top'].set_visible(False)\n", + " ax.spines['left'].set_visible(False)\n", + " ax.spines['right'].set_visible(False)\n", + "plot_grid(5,5,2,2,symmetric=False)\n", + "plt.savefig('Horizontal_NE_indexing_nonsym.png',bbox_inches='tight')" + ] + }, + { + "cell_type": "code", + "execution_count": null, + "metadata": {}, + "outputs": [], + "source": [ + "plot_grid(5,5,2,2)\n", + "plt.savefig('Horizontal_NE_indexing_sym.png',bbox_inches='tight')" + ] + } + ], + "metadata": { + "anaconda-cloud": {}, + "kernelspec": { + "display_name": "Python [default]", + "language": "python", + "name": "python3" + }, + "language_info": { + "codemirror_mode": { + "name": "ipython", + "version": 3 + }, + "file_extension": ".py", + "mimetype": "text/x-python", + "name": "python", + "nbconvert_exporter": "python", + "pygments_lexer": "ipython3", + "version": "3.5.3" + } + }, + "nbformat": 4, + "nbformat_minor": 1 +} diff --git a/docs/images/Horizontal_NE_indexing_nonsym.png b/docs/images/Horizontal_NE_indexing_nonsym.png index 6316a64e7a..3106749e3a 100644 Binary files a/docs/images/Horizontal_NE_indexing_nonsym.png and b/docs/images/Horizontal_NE_indexing_nonsym.png differ diff --git a/src/ALE/MOM_ALE.F90 b/src/ALE/MOM_ALE.F90 index dcb5cb4e25..5a1347ab62 100644 --- a/src/ALE/MOM_ALE.F90 +++ b/src/ALE/MOM_ALE.F90 @@ -8,9 +8,12 @@ module MOM_ALE ! This file is part of MOM6. See LICENSE.md for the license. +use MOM_debugging, only : check_column_integrals use MOM_diag_mediator, only : register_diag_field, post_data, diag_ctrl, time_type +use MOM_diag_vkernels, only : interpolate_column, reintegrate_column use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_EOS, only : calculate_density +use MOM_domains, only : create_group_pass, do_group_pass, group_pass_type use MOM_error_handler, only : MOM_error, FATAL, WARNING use MOM_error_handler, only : callTree_showQuery use MOM_error_handler, only : callTree_enter, callTree_leave, callTree_waypoint @@ -36,7 +39,7 @@ module MOM_ALE use MOM_remapping, only : remappingSchemesDoc, remappingDefaultScheme use MOM_remapping, only : remapping_CS, dzFromH1H2 use MOM_string_functions, only : uppercase, extractWord, extract_integer -use MOM_tracer_registry, only : tracer_registry_type +use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chkinv use MOM_variables, only : ocean_grid_type, thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -105,6 +108,7 @@ module MOM_ALE public ALE_end public ALE_main public ALE_main_offline +public ALE_offline_inputs public ALE_offline_tracer_final public ALE_build_grid public ALE_regrid_accelerated @@ -138,7 +142,7 @@ subroutine ALE_init( param_file, GV, max_depth, CS) ! Local variables real, dimension(:), allocatable :: dz - character(len=40) :: mod = "MOM_ALE" ! This module's name. + character(len=40) :: mdl = "MOM_ALE" ! This module's name. character(len=80) :: string ! Temporary strings real :: filter_shallow_depth, filter_deep_depth logical :: check_reconstruction @@ -159,7 +163,7 @@ subroutine ALE_init( param_file, GV, max_depth, CS) ! --- BOUNDARY EXTRAPOLATION -- ! This sets whether high-order (rather than PCM) reconstruction schemes ! should be used within boundary cells - call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION_PRESSURE", & + call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION_PRESSURE", & CS%boundary_extrapolation_for_pressure, & "When defined, the reconstruction is extrapolated\n"//& "within boundary cells rather than assume PCM for the.\n"//& @@ -168,7 +172,7 @@ subroutine ALE_init( param_file, GV, max_depth, CS) "boundary cells.", default=.true.) ! --- PRESSURE GRADIENT CALCULATION --- - call get_param(param_file, mod, "RECONSTRUCT_FOR_PRESSURE", & + call get_param(param_file, mdl, "RECONSTRUCT_FOR_PRESSURE", & CS%reconstructForPressure , & "If True, use vertical reconstruction of T/S within\n"//& "the integrals of teh FV pressure gradient calculation.\n"//& @@ -176,14 +180,14 @@ subroutine ALE_init( param_file, GV, max_depth, CS) "By default, this is True when using ALE and False otherwise.", & default=.true. ) - call get_param(param_file, mod, "PRESSURE_RECONSTRUCTION_SCHEME", & + call get_param(param_file, mdl, "PRESSURE_RECONSTRUCTION_SCHEME", & CS%pressureReconstructionScheme, & "Type of vertical reconstruction of T/S to use in integrals\n"//& "within the FV pressure gradient calculation."//& " 1: PLM reconstruction.\n"//& " 2: PPM reconstruction.", default=PRESSURE_RECONSTRUCTION_PLM) - call get_param(param_file, mod, "REMAP_UV_USING_OLD_ALG", & + call get_param(param_file, mdl, "REMAP_UV_USING_OLD_ALG", & CS%remap_uv_using_old_alg, & "If true, uses the old remapping-via-a-delta-z method for\n"//& "remapping u and v. If false, uses the new method that remaps\n"//& @@ -191,23 +195,23 @@ subroutine ALE_init( param_file, GV, max_depth, CS) default=.true.) ! Initialize and configure regridding - call ALE_initRegridding( GV, max_depth, param_file, mod, CS%regridCS) + call ALE_initRegridding( GV, max_depth, param_file, mdl, CS%regridCS) ! Initialize and configure remapping - call get_param(param_file, mod, "REMAPPING_SCHEME", string, & + call get_param(param_file, mdl, "REMAPPING_SCHEME", string, & "This sets the reconstruction scheme used\n"//& "for vertical remapping for all variables.\n"//& "It can be one of the following schemes:\n"//& trim(remappingSchemesDoc), default=remappingDefaultScheme) - call get_param(param_file, mod, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & + call get_param(param_file, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for\n"//& "consistency and if non-monotonicty or an inconsistency is\n"//& "detected then a FATAL error is issued.", default=.false.) - call get_param(param_file, mod, "FATAL_CHECK_REMAPPING", check_remapping, & + call get_param(param_file, mdl, "FATAL_CHECK_REMAPPING", check_remapping, & "If true, the results of remapping are checked for\n"//& "conservation and new extrema and if an inconsistency is\n"//& "detected then a FATAL error is issued.", default=.false.) - call get_param(param_file, mod, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & + call get_param(param_file, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & "If true, the values on the intermediate grid used for remapping\n"//& "are forced to be bounded, which might not be the case due to\n"//& "round off.", default=.false.) @@ -217,29 +221,29 @@ subroutine ALE_init( param_file, GV, max_depth, CS) check_remapping=check_remapping, & force_bounds_in_subcell=force_bounds_in_subcell) - call get_param(param_file, mod, "REMAP_AFTER_INITIALIZATION", CS%remap_after_initialization, & + call get_param(param_file, mdl, "REMAP_AFTER_INITIALIZATION", CS%remap_after_initialization, & "If true, applies regridding and remapping immediately after\n"//& "initialization so that the state is ALE consistent. This is a\n"//& "legacy step and should not be needed if the initialization is\n"//& "consistent with the coordinate mode.", default=.true.) - call get_param(param_file, mod, "REGRID_TIME_SCALE", CS%regrid_time_scale, & + call get_param(param_file, mdl, "REGRID_TIME_SCALE", CS%regrid_time_scale, & "The time-scale used in blending between the current (old) grid\n"//& "and the target (new) grid. A short time-scale favors the target\n"//& "grid (0. or anything less than DT_THERM) has no memory of the old\n"//& "grid. A very long time-scale makes the model more Lagrangian.", & units="s", default=0.) - call get_param(param_file, mod, "REGRID_FILTER_SHALLOW_DEPTH", filter_shallow_depth, & + call get_param(param_file, mdl, "REGRID_FILTER_SHALLOW_DEPTH", filter_shallow_depth, & "The depth above which no time-filtering is applied. Above this depth\n"//& "final grid exactly matches the target (new) grid.", units="m", default=0.) - call get_param(param_file, mod, "REGRID_FILTER_DEEP_DEPTH", filter_deep_depth, & + call get_param(param_file, mdl, "REGRID_FILTER_DEEP_DEPTH", filter_deep_depth, & "The depth below which full time-filtering is applied with time-scale\n"//& "REGRID_TIME_SCALE. Between depths REGRID_FILTER_SHALLOW_DEPTH and\n"//& "REGRID_FILTER_SHALLOW_DEPTH the filter wieghts adopt a cubic profile.", & units="m", default=0.) call set_regrid_params(CS%regridCS, depth_of_time_filter_shallow=filter_shallow_depth*GV%m_to_H, & depth_of_time_filter_deep=filter_deep_depth*GV%m_to_H) - call get_param(param_file, mod, "REGRID_USE_OLD_DIRECTION", local_logical, & + call get_param(param_file, mdl, "REGRID_USE_OLD_DIRECTION", local_logical, & "If true, the regridding ntegrates upwards from the bottom for\n"//& "interface positions, much as the main model does. If false\n"//& "regridding integrates downward, consistant with the remapping\n"//& @@ -488,51 +492,130 @@ subroutine ALE_main_offline( G, GV, h, tv, Reg, CS, dt) end subroutine ALE_main_offline +!> Regrid/remap stored fields used for offline tracer integrations. These input fields are assumed to have +!! the same layer thicknesses at the end of the last offline interval (which should be a Zstar grid). This +!! routine builds a grid on the runtime specified vertical coordinate +subroutine ALE_offline_inputs(CS, G, GV, h, tv, Reg, uhtr, vhtr, Kd, debug) + type(ALE_CS), pointer :: CS !< Regridding parameters and options + type(ocean_grid_type), intent(in ) :: G !< Ocean grid informations + type(verticalGrid_type), intent(in ) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Layer thicknesses + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure + type(tracer_registry_type), pointer :: Reg !< Tracer registry structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(GV)), intent(inout) :: uhtr !< Zonal mass fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(GV)), intent(inout) :: vhtr !< Meridional mass fluxes + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)+1), intent(inout) :: Kd !< Input diffusivites + logical, intent(in ) :: debug !< If true, then turn checksums + ! Local variables + integer :: nk, i, j, k, isc, iec, jsc, jec + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new ! Layer thicknesses after regridding + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions + real, dimension(SZK_(GV)) :: h_src + real, dimension(SZK_(GV)) :: h_dest, uh_dest + real, dimension(SZK_(GV)) :: temp_vec + + nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec + dzRegrid(:,:,:) = 0.0 + h_new(:,:,:) = 0.0 + + if (debug) call MOM_tracer_chkinv("Before ALE_offline_inputs", G, h, Reg%Tr, Reg%ntr) + + ! Build new grid from the Zstar state onto the requested vertical coordinate. The new grid is stored + ! in h_new. The old grid is h. Both are needed for the subsequent remapping of variables. Convective + ! adjustment right now is not used because it is unclear what to do with vanished layers + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h, tv, h_new, dzRegrid, conv_adjust = .false. ) + call check_grid( G, GV, h_new, 0. ) + if (CS%show_call_tree) call callTree_waypoint("new grid generated (ALE_offline_inputs)") + + ! Remap all variables from old grid h onto new grid h_new + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, debug=CS%show_call_tree ) + if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_inputs)") + + ! Reintegrate mass transports from Zstar to the offline vertical coordinate + do j=jsc,jec ; do i=G%iscB,G%iecB + if (G%mask2dCu(i,j)>0.) then + h_src(:) = 0.5 * (h(i,j,:) + h(i+1,j,:)) + h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i+1,j,:)) + call reintegrate_column(nk, h_src, uhtr(I,j,:), nk, h_dest, 0., temp_vec) + uhtr(I,j,:) = temp_vec + endif + enddo ; enddo + do j=G%jscB,G%jecB ; do i=isc,iec + if (G%mask2dCv(i,j)>0.) then + h_src(:) = 0.5 * (h(i,j,:) + h(i,j+1,:)) + h_dest(:) = 0.5 * (h_new(i,j,:) + h_new(i,j+1,:)) + call reintegrate_column(nk, h_src, vhtr(I,j,:), nk, h_dest, 0., temp_vec) + vhtr(I,j,:) = temp_vec + endif + enddo ; enddo + + do j = jsc,jec ; do i=isc,iec + if (G%mask2dT(i,j)>0.) then + if (check_column_integrals(nk, h_src, nk, h_dest)) then + call MOM_error(FATAL, "ALE_offline_inputs: Kd interpolation columns do not match") + endif + call interpolate_column(nk, h(i,j,:), Kd(i,j,:), nk, h_new(i,j,:), 0., Kd(i,j,:)) + endif + enddo ; enddo; + + call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%T, h_new, tv%T) + call ALE_remap_scalar(CS%remapCS, G, GV, nk, h, tv%S, h_new, tv%S) + + if (debug) call MOM_tracer_chkinv("After ALE_offline_inputs", G, h_new, Reg%Tr, Reg%ntr) + + ! Copy over the new layer thicknesses + do k = 1,nk ; do j = jsc-1,jec+1 ; do i = isc-1,iec+1 + h(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + if (CS%show_call_tree) call callTree_leave("ALE_offline_inputs()") +end subroutine ALE_offline_inputs + + !> Remaps all tracers from h onto h_target. This is intended to be called when tracers !! are done offline. In the case where transports don't quite conserve, we still want to !! make sure that layer thicknesses offline do not drift too far away from the online model -subroutine ALE_offline_tracer_final( G, GV, h, h_target, Reg, CS) +subroutine ALE_offline_tracer_final( G, GV, h, tv, h_target, Reg, CS) type(ocean_grid_type), intent(in) :: G !< Ocean grid informations type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after last time step (m or Pa) - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h_target !< Current 3D grid obtained after last time step (m or Pa) + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h !< Current 3D grid obtained after + !! last time step (m or Pa) + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamic variable structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_target !< Current 3D grid obtained after + !! last time step (m or Pa) type(tracer_registry_type), pointer :: Reg !< Tracer registry structure type(ALE_CS), pointer :: CS !< Regridding parameters and options ! Local variables - real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid ! The change in grid interface positions + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)+1) :: dzRegrid !< The change in grid interface positions + real, dimension(SZI_(G), SZJ_(G), SZK_(GV)) :: h_new !< Regridded target thicknesses integer :: nk, i, j, k, isc, iec, jsc, jec nk = GV%ke; isc = G%isc; iec = G%iec; jsc = G%jsc; jec = G%jec if (CS%show_call_tree) call callTree_enter("ALE_offline_tracer_final(), MOM_ALE.F90") - - ! It does not seem that remap_all_state_vars uses dzRegrid for tracers, only for u, v - dzRegrid(:,:,:) = 0.0 - - call check_grid( G, GV, h, 0. ) + ! Need to make sure that h_target is consistent with the current offline ALE confiuration + call regridding_main( CS%remapCS, CS%regridCS, G, GV, h_target, tv, h_new, dzRegrid ) call check_grid( G, GV, h_target, 0. ) - if (CS%show_call_tree) call callTree_waypoint("Source and target grids checked (ALE_offline_tracer)") + + if (CS%show_call_tree) call callTree_waypoint("Source and target grids checked (ALE_offline_tracer_final)") ! Remap all variables from old grid h onto new grid h_new - call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_target, Reg, & - debug=CS%show_call_tree ) + call remap_all_state_vars( CS%remapCS, CS, G, GV, h, h_new, Reg, debug=CS%show_call_tree ) - if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_offline_tracer)") + if (CS%show_call_tree) call callTree_waypoint("state remapped (ALE_offline_tracer_final)") ! Override old grid with new one. The new grid 'h_new' is built in ! one of the 'build_...' routines above. -!$OMP parallel do default(none) shared(isc,iec,jsc,jec,nk,h,h_target,CS) + !$OMP parallel do default(shared) do k = 1,nk do j = jsc-1,jec+1 ; do i = isc-1,iec+1 - h(i,j,k) = h_target(i,j,k) + h(i,j,k) = h_new(i,j,k) enddo ; enddo enddo - - if (CS%show_call_tree) call callTree_leave("ALE_offline_tracer()") - + if (CS%show_call_tree) call callTree_leave("ALE_offline_tracer_final()") end subroutine ALE_offline_tracer_final !> Check grid for negative thicknesses @@ -1101,22 +1184,22 @@ integer function pressureReconstructionScheme(CS) end function pressureReconstructionScheme !> Initializes regridding for the main ALE algorithm -subroutine ALE_initRegridding(GV, max_depth, param_file, mod, regridCS) +subroutine ALE_initRegridding(GV, max_depth, param_file, mdl, regridCS) type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure real, intent(in) :: max_depth !< The maximum depth of the ocean, in m. type(param_file_type), intent(in) :: param_file !< parameter file - character(len=*), intent(in) :: mod !< Name of calling module + character(len=*), intent(in) :: mdl !< Name of calling module type(regridding_CS), intent(out) :: regridCS !< Regridding parameters and work arrays ! Local variables character(len=30) :: coord_mode - call get_param(param_file, mod, "REGRIDDING_COORDINATE_MODE", coord_mode, & + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", coord_mode, & "Coordinate mode for vertical regridding.\n"//& "Choose among the following possibilities:\n"//& trim(regriddingCoordinateModeDoc), & default=DEFAULT_COORDINATE_MODE, fail_if_missing=.true.) - call initialize_regridding(regridCS, GV, max_depth, param_file, mod, coord_mode, '', '') + call initialize_regridding(regridCS, GV, max_depth, param_file, mdl, coord_mode, '', '') end subroutine ALE_initRegridding diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index de6828a0da..43d63d22a9 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -757,7 +757,7 @@ end subroutine end_regridding !------------------------------------------------------------------------------ ! Dispatching regridding routine: regridding & remapping !------------------------------------------------------------------------------ -subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_shelf_h) +subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_shelf_h, conv_adjust) !------------------------------------------------------------------------------ ! This routine takes care of (1) building a new grid and (2) remapping between ! the old grid and the new grid. The creation of the new grid can be based @@ -785,9 +785,14 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ real, dimension(SZI_(G),SZJ_(G), SZK_(GV)), intent(inout) :: h_new !< New 3D grid consistent with target coordinate real, dimension(SZI_(G),SZJ_(G), SZK_(GV)+1), intent(inout) :: dzInterface !< The change in position of each interface real, dimension(:,:), optional, pointer :: frac_shelf_h !< Fractional ice shelf coverage + logical, optional, intent(in ) :: conv_adjust ! If true, do convective adjustment ! Local variables real :: trickGnuCompiler logical :: use_ice_shelf + logical :: do_convective_adjustment + + do_convective_adjustment = .true. + if (present(conv_adjust)) do_convective_adjustment = conv_adjust use_ice_shelf = .false. if (present(frac_shelf_h)) then @@ -813,7 +818,7 @@ subroutine regridding_main( remapCS, CS, G, GV, h, tv, h_new, dzInterface, frac_ call calc_h_new_by_dz(G, GV, h, dzInterface, h_new) case ( REGRIDDING_RHO ) - call convective_adjustment(G, GV, h, tv) + if (do_convective_adjustment) call convective_adjustment(G, GV, h, tv) call build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) call calc_h_new_by_dz(G, GV, h, dzInterface, h_new) @@ -1275,6 +1280,9 @@ subroutine build_rho_grid( G, GV, h, tv, dzInterface, remapCS, CS ) integer :: i, j, k real :: nominalDepth, totalThickness real, dimension(SZK_(GV)+1) :: zOld, zNew +#ifdef __DO_SAFETY_CHECKS__ + real :: dh +#endif nz = GV%ke diff --git a/src/ALE/MOM_remapping.F90 b/src/ALE/MOM_remapping.F90 index b6909e7fa2..bf68782438 100644 --- a/src/ALE/MOM_remapping.F90 +++ b/src/ALE/MOM_remapping.F90 @@ -54,7 +54,7 @@ module MOM_remapping integer, parameter :: INTEGRATION_PPM = 3 !< Piecewise Parabolic Method integer, parameter :: INTEGRATION_PQM = 5 !< Piecewise Quartic Method -character(len=40) :: mod = "MOM_remapping" !< This module's name. +character(len=40) :: mdl = "MOM_remapping" !< This module's name. !> Documentation for external callers character(len=256), public :: remappingSchemesDoc = & diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index 0f7ebdf1a0..1b19d45ea7 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -131,10 +131,12 @@ module MOM use MOM_verticalGrid, only : verticalGrid_type, verticalGridInit, verticalGridEnd use MOM_verticalGrid, only : get_thickness_units, get_flux_units, get_tr_flux_units ! Offline modules -use MOM_offline_main, only : offline_transport_CS, offline_transport_init, transport_by_files +use MOM_offline_main, only : offline_transport_CS, offline_transport_init, update_offline_fields +use MOM_offline_main, only : insert_offline_main, extract_offline_main, post_offline_convergence_diags use MOM_offline_main, only : register_diags_offline_transport, offline_advection_ale use MOM_offline_main, only : offline_redistribute_residual, offline_diabatic_ale -use MOM_offline_main, only : offline_advection_layer +use MOM_offline_main, only : offline_fw_fluxes_into_ocean, offline_fw_fluxes_out_ocean +use MOM_offline_main, only : offline_advection_layer, offline_transport_end use MOM_ALE, only : ale_offline_tracer_final, ALE_main_offline @@ -186,7 +188,7 @@ module MOM logical :: adiabatic !< If true, then no diapycnal mass fluxes, with no calls !! to routines to calculate or apply diapycnal fluxes. logical :: use_temperature !< If true, temp and saln used as state variables. - logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level + logical :: calc_rho_for_sea_lev !< If true, calculate rho to convert pressure to sea level logical :: use_frazil !< If true, liquid seawater freezes if temp below freezing, !! with accumulated heat deficit returned to surface ocean. logical :: bound_salinity !< If true, salt is added to keep salinity above @@ -212,7 +214,7 @@ module MOM logical :: do_dynamics !< If false, does not call step_MOM_dyn_*. This is an !! undocumented run-time flag that is fragile. logical :: offline_tracer_mode = .false. - !< If true, step_tracers() is called instead of step_MOM(). + !< If true, step_offline() is called instead of step_MOM(). !! This is intended for running MOM6 in offline tracer mode logical :: advect_TS !< If false, then no horizontal advection of temperature !! and salnity is performed @@ -366,6 +368,9 @@ module MOM integer :: id_T_vardec = -1 integer :: id_S_vardec = -1 + ! fields prior to doing dynamics + integer :: id_h_pre_dyn = -1 + ! diagnostic for fields prior to applying diapycnal physics integer :: id_u_predia = -1 integer :: id_v_predia = -1 @@ -413,12 +418,11 @@ module MOM ! These are used for group halo updates. type(group_pass_type) :: pass_tau_ustar_psurf - type(group_pass_type) :: pass_h type(group_pass_type) :: pass_ray type(group_pass_type) :: pass_bbl_thick_kv_bbl type(group_pass_type) :: pass_T_S_h type(group_pass_type) :: pass_T_S - type(group_pass_type) :: pass_kd_kv_turb + type(group_pass_type) :: pass_kv_turb type(group_pass_type) :: pass_uv_T_S_h type(group_pass_type) :: pass_ssh @@ -427,7 +431,7 @@ module MOM public initialize_MOM public finish_MOM_initialization public step_MOM -public step_tracers +public step_offline public MOM_end public calculate_surface_state @@ -438,6 +442,7 @@ module MOM integer :: id_clock_diabatic integer :: id_clock_continuity ! also in dynamics s/r integer :: id_clock_thick_diff +integer :: id_clock_BBL_visc integer :: id_clock_ml_restrat integer :: id_clock_diagnostics integer :: id_clock_Z_diag @@ -447,6 +452,7 @@ module MOM integer :: id_clock_pass_init ! also in dynamics d/r integer :: id_clock_ALE integer :: id_clock_other +integer :: id_clock_offline_tracer contains @@ -460,7 +466,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval + real, intent(in) :: time_interval !< time interval covered by this run segment, in s. type(MOM_control_struct), pointer :: CS !< control structure from initialize_MOM ! local @@ -488,10 +494,13 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! layers, and positive if it will be applied later. real :: wt_end, wt_beg + real :: bbl_time_int ! The amount of time over which the calculated BBL + ! properties will apply, for use in diagnostics. logical :: calc_dtbt ! Indicates whether the dynamically adjusted ! barotropic time step needs to be updated. logical :: do_advection ! If true, it is time to advect tracers. + logical :: do_calc_bbl ! If true, calculate the boundary layer properties. logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans ! multiple dynamic timesteps. real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & @@ -511,7 +520,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) type(time_type) :: Time_local logical :: showCallTree ! These are used for group halo passes. - logical :: do_pass_kd_kv_turb, do_pass_ray, do_pass_kv_bbl_thick + logical :: do_pass_kv_turb, do_pass_Ray, do_pass_kv_bbl_thick G => CS%G ; GV => CS%GV is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -554,8 +563,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) dt_therm = dt*ntstep endif - CS%visc%calc_bbl = .true. - if (.not.ASSOCIATED(fluxes%p_surf)) CS%interp_p_surf = .false. !---------- Begin setup for group halo pass @@ -566,31 +573,30 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call create_group_pass(CS%pass_tau_ustar_psurf, fluxes%ustar(:,:), G%Domain) if (ASSOCIATED(fluxes%p_surf)) & call create_group_pass(CS%pass_tau_ustar_psurf, fluxes%p_surf(:,:), G%Domain) - if (CS%thickness_diffuse .OR. CS%mixedlayer_restrat) & - call create_group_pass(CS%pass_h, h, G%Domain) !###, halo=max(2,cont_stensil)) - - if (CS%diabatic_first) then - do_pass_ray = .FALSE. - if ((.not.G%Domain%symmetric) .and. & - associated(CS%visc%Ray_u) .and. associated(CS%visc%Ray_v)) then - call create_group_pass(CS%pass_ray, CS%visc%Ray_u, CS%visc%Ray_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_ray = .TRUE. - endif - do_pass_kv_bbl_thick = .FALSE. - if (associated(CS%visc%bbl_thick_u) .and. associated(CS%visc%bbl_thick_v)) then - call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%bbl_thick_u, & - CS%visc%bbl_thick_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif - if (associated(CS%visc%kv_bbl_u) .and. associated(CS%visc%kv_bbl_v)) then - call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%kv_bbl_u, & - CS%visc%kv_bbl_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif + + do_pass_Ray = .FALSE. + if ((.not.G%Domain%symmetric) .and. & + associated(CS%visc%Ray_u) .and. associated(CS%visc%Ray_v)) then + call create_group_pass(CS%pass_ray, CS%visc%Ray_u, CS%visc%Ray_v, G%Domain, & + To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) + do_pass_Ray = .TRUE. + endif + do_pass_kv_bbl_thick = .FALSE. + if (associated(CS%visc%bbl_thick_u) .and. associated(CS%visc%bbl_thick_v)) then + call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%bbl_thick_u, & + CS%visc%bbl_thick_v, G%Domain, & + To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) + do_pass_kv_bbl_thick = .TRUE. + endif + if (associated(CS%visc%kv_bbl_u) .and. associated(CS%visc%kv_bbl_v)) then + call create_group_pass(CS%pass_bbl_thick_kv_bbl, CS%visc%kv_bbl_u, & + CS%visc%kv_bbl_v, G%Domain, & + To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) + do_pass_kv_bbl_thick = .TRUE. endif + do_pass_kv_turb = associated(CS%visc%Kv_turb) + if (associated(CS%visc%Kv_turb)) & + call create_group_pass(CS%pass_kv_turb, CS%visc%Kv_turb, G%Domain, To_All+Omit_Corners, halo=1) if (.not.CS%adiabatic .AND. CS%use_ALE_algorithm ) then if (CS%use_temperature) then @@ -605,14 +611,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) call create_group_pass(CS%pass_T_S, CS%tv%S, G%Domain, halo=1) endif - if (associated(CS%visc%Kv_turb)) & - call create_group_pass(CS%pass_kd_kv_turb, CS%visc%Kv_turb, G%Domain, To_All+Omit_Corners, halo=1) - !---------- End setup for group halo pass - do_pass_kd_kv_turb = associated(CS%visc%Kv_turb) - if (G%nonblocking_updates) then call start_group_pass(CS%pass_tau_ustar_psurf, G%Domain) else @@ -709,12 +710,12 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) ! This is here so that CS%visc is updated before diabatic() when ! DIABATIC_FIRST=True. Otherwise diabatic() is called after the dynamics ! and set_viscous_BBL is called as a part of the dynamic stepping. - !call cpu_clock_begin(id_clock_vertvisc) + call cpu_clock_begin(id_clock_BBL_visc) call set_viscous_BBL(u, v, h, CS%tv, CS%visc, G, GV, CS%set_visc_CSp) - !call cpu_clock_end(id_clock_vertvisc) + call cpu_clock_end(id_clock_BBL_visc) call cpu_clock_begin(id_clock_pass) - if (do_pass_ray) call do_group_pass(CS%pass_ray, G%Domain ) + if (do_pass_Ray) call do_group_pass(CS%pass_ray, G%Domain ) if (do_pass_kv_bbl_thick) call do_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain) call cpu_clock_end(id_clock_pass) if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (diabatic_first)") @@ -738,13 +739,9 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif ! end of block "(CS%diabatic_first .and. (CS%t_dyn_rel_adv==0.0))" - call cpu_clock_begin(id_clock_other) ; call cpu_clock_begin(id_clock_pass) - if (do_pass_kd_kv_turb) call do_group_pass(CS%pass_kd_kv_turb, G%Domain) - call cpu_clock_end(id_clock_pass) ; call cpu_clock_end(id_clock_other) - - !=========================================================================== ! This is the start of the dynamics stepping part of the algorithm. + call cpu_clock_begin(id_clock_dynamics) call disable_averaging(CS%diag) @@ -764,7 +761,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) CS%MEKE, CS%VarMix, CS%CDp, CS%thickness_diffuse_CSp) call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) - call do_group_pass(CS%pass_h, G%Domain) + call pass_var(h, G%Domain) !###, halo=max(2,cont_stensil)) call cpu_clock_end(id_clock_pass) call disable_averaging(CS%diag) if (showCallTree) call callTree_waypoint("finished thickness_diffuse_first (step_MOM)") @@ -776,6 +773,39 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif endif + ! The bottom boundary layer properties are out-of-date and need to be + ! recalculated. This always occurs at the start of a coupling time + ! step because the externally prescribed stresses may have changed. + do_calc_bbl = ((CS%t_dyn_rel_adv == 0.0) .or. (n==1)) + if (do_calc_bbl) then + ! Calculate the BBL properties and store them inside visc (u,h). + call cpu_clock_begin(id_clock_BBL_visc) + bbl_time_int = max(dt, min(dt_therm - CS%t_dyn_rel_adv, dt*(1+n_max-n)) ) + call enable_averaging(bbl_time_int, & + Time_local+set_time(int(bbl_time_int-dt+0.5)), CS%diag) + call set_viscous_BBL(u, v, h, CS%tv, CS%visc, G, GV, CS%set_visc_CSp) + call disable_averaging(CS%diag) + call cpu_clock_end(id_clock_BBL_visc) + if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM)") + endif + + call cpu_clock_begin(id_clock_pass) + if (do_pass_kv_turb) call do_group_pass(CS%pass_kv_turb, G%Domain) + call cpu_clock_end(id_clock_pass) + + if (do_calc_bbl) then + call cpu_clock_begin(id_clock_pass) + if (G%nonblocking_updates) then + if (do_pass_Ray) call start_group_pass(CS%pass_Ray, G%Domain) + if (do_pass_kv_bbl_thick) call start_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain) + ! do_calc_bbl will be set to .false. when the message passing is complete. + else + if (do_pass_Ray) call do_group_pass(CS%pass_Ray, G%Domain) + if (do_pass_kv_bbl_thick) call do_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain) + endif + call cpu_clock_end(id_clock_pass) + endif + if (CS%interp_p_surf) then wt_end = real(n) / real(n_max) wt_beg = real(n-1) / real(n_max) @@ -787,12 +817,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) enddo ; enddo endif - if (CS%visc%calc_bbl) then ; if (thermo_does_span_coupling) then - CS%visc%bbl_calc_time_interval = dt_therm - else - CS%visc%bbl_calc_time_interval = dt*real(1+MIN(ntstep-MOD(n,ntstep),n_max-n)) - endif ; endif - if (associated(CS%u_prev) .and. associated(CS%v_prev)) then do k=1,nz ; do j=jsd,jed ; do I=IsdB,IedB CS%u_prev(I,j,k) = u(I,j,k) @@ -807,6 +831,13 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) h_pre_dyn(i,j,k) = h(i,j,k) enddo ; enddo ; enddo + if (G%nonblocking_updates) then ; if (do_calc_bbl) then + call cpu_clock_begin(id_clock_pass) + if (do_pass_Ray) call complete_group_pass(CS%pass_Ray, G%Domain) + if (do_pass_kv_bbl_thick) call complete_group_pass(CS%pass_bbl_thick_kv_bbl, G%Domain) + call cpu_clock_end(id_clock_pass) + endif ; endif + if (CS%do_dynamics .and. CS%split) then !--------------------------- start SPLIT ! This section uses a split time stepping scheme for the dynamic equations, ! basically the stacked shallow water equations with viscosity. @@ -819,9 +850,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) dtbt_reset_time = CS%rel_time endif - mass_src_time = CS%t_dyn_rel_adv - !### This should be mass_src_time = CS%t_dyn_rel_thermo - + mass_src_time = CS%t_dyn_rel_thermo if (CS%legacy_split) then call step_MOM_dyn_legacy_split(u, v, h, CS%tv, CS%visc, & Time_local, dt, fluxes, CS%p_surf_begin, CS%p_surf_end, & @@ -872,7 +901,7 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) if (CS%debug) call hchksum(h,"Post-thickness_diffuse h", G%HI, haloshift=1, scale=GV%H_to_m) call cpu_clock_end(id_clock_thick_diff) call cpu_clock_begin(id_clock_pass) - call do_group_pass(CS%pass_h, G%Domain) + call pass_var(h, G%Domain) !###, halo=max(2,cont_stensil)) call cpu_clock_end(id_clock_pass) if (showCallTree) call callTree_waypoint("finished thickness_diffuse (step_MOM)") endif @@ -886,10 +915,10 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_ml_restrat) call mixedlayer_restrat(h, CS%uhtr ,CS%vhtr, CS%tv, fluxes, dt, CS%visc%MLD, & - G, GV, CS%mixedlayer_restrat_CSp) + CS%VarMix, G, GV, CS%mixedlayer_restrat_CSp) call cpu_clock_end(id_clock_ml_restrat) call cpu_clock_begin(id_clock_pass) - call do_group_pass(CS%pass_h, G%Domain) + call pass_var(h, G%Domain) !###, halo=max(2,cont_stensil)) call cpu_clock_end(id_clock_pass) if (CS%debug) then call hchksum(h,"Post-mixedlayer_restrat h", G%HI, haloshift=1, scale=GV%H_to_m) @@ -1015,8 +1044,6 @@ subroutine step_MOM(fluxes, state, Time_start, time_interval, CS) endif call cpu_clock_begin(id_clock_dynamics) - ! The bottom boundary layer properties are out-of-date and need to be recalculated. - if (CS%t_dyn_rel_adv == 0.0) CS%visc%calc_bbl = .true. ! Determining the time-average sea surface height is part of the algorithm. ! This may be eta_av if Boussinesq, or need to be diagnosed if not. @@ -1259,11 +1286,11 @@ subroutine step_MOM_thermo(CS, G, GV, u, v, h, tv, fluxes, dtdia) end subroutine step_MOM_thermo -!> step_tracers is the main driver for running tracers offline in MOM6. This has been primarily +!> step_offline is the main driver for running tracers offline in MOM6. This has been primarily !! developed with ALE configurations in mind. Some work has been done in isopycnal configuration, but !! the work is very preliminary. Some more detail about this capability along with some of the subroutines !! called here can be found in tracers/MOM_offline_control.F90 -subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) +subroutine step_offline(fluxes, state, Time_start, time_interval, CS) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(surface), intent(inout) :: state !< surface ocean state type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type @@ -1276,172 +1303,177 @@ subroutine step_tracers(fluxes, state, Time_start, time_interval, CS) type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid - logical :: first_iter ! True if this is the first time step_tracers has been called in a given interval - logical :: last_iter ! True if this is the last time step_tracer is to be called in an offline interval - logical :: adv_converged ! True if all the horizontal fluxes have been used + logical :: first_iter !< True if this is the first time step_offline has been called in a given interval + logical :: last_iter !< True if this is the last time step_tracer is to be called in an offline interval + logical :: do_vertical !< If enough time has elapsed, do the diabatic tracer sources/sinks + logical :: adv_converged !< True if all the horizontal fluxes have been used + + integer :: dt_offline, dt_offline_vertical + logical :: skip_diffusion + integer :: id_eta_diff_end integer, pointer :: accumulated_time + integer :: i,j,k + integer :: is, ie, js, je, isd, ied, jsd, jed ! 3D pointers real, dimension(:,:,:), pointer :: & uhtr, vhtr, & eatr, ebtr, & - temp_mean, & - salt_mean, & h_end + ! 2D Array for diagnostics + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_pre, eta_end type(time_type) :: Time_end ! End time of a segment, as a time type - integer :: num_iter_vert - real :: Initer_vert - - num_iter_vert = floor((CS%offline_CSp%dt_offline+0.0001)/time_interval) - Initer_vert = 1./num_iter_vert ! Grid-related pointer assignments G => CS%G GV => CS%GV - ! Pointer assignments to necessary fields from main MOM CS - CS%offline_CSp%ALE_CSp => CS%ALE_CSp - CS%offline_CSp%diabatic_CSp => CS%diabatic_CSp - CS%offline_CSp%diag => CS%diag - CS%offline_CSp%OBC => CS%OBC - CS%offline_CSp%tracer_adv_CSp => CS%tracer_adv_CSp - CS%offline_CSp%tracer_flow_CSp => CS%tracer_flow_CSp - CS%offline_CSp%tracer_Reg => CS%tracer_Reg - CS%offline_CSp%tv => CS%tv - - ! Assignments for fields stored in offline CS - uhtr => CS%offline_CSp%uhtr - vhtr => CS%offline_CSp%vhtr - eatr => CS%offline_CSp%eatr - ebtr => CS%offline_CSp%ebtr - temp_mean => CS%offline_CSp%temp_mean - salt_mean => CS%offline_CSp%salt_mean - h_end => CS%offline_CSp%h_end - accumulated_time => CS%offline_CSp%accumulated_time - - call cpu_clock_begin(id_clock_tracer) + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec + isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed + + call cpu_clock_begin(id_clock_offline_tracer) + call extract_offline_main(CS%offline_CSp, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, & + dt_offline, dt_offline_vertical, skip_diffusion) Time_end = increment_date(Time_start, seconds=floor(time_interval+0.001)) call enable_averaging(time_interval, Time_end, CS%diag) + ! Check to see if this is the first iteration of the offline interval if(accumulated_time==0) then first_iter = .true. else ! This is probably unnecessary but is used to guard against unwanted behavior first_iter = .false. endif + ! Check to see if vertical tracer functions should be done + if ( mod(accumulated_time, dt_offline_vertical) == 0 ) then + do_vertical = .true. + else + do_vertical = .false. + endif + ! Increment the amount of time elapsed since last read and check if it's time to roll around - accumulated_time = mod(accumulated_time + int(time_interval), int(CS%offline_CSp%dt_offline)) + accumulated_time = mod(accumulated_time + int(time_interval), dt_offline) if(accumulated_time==0) then last_iter = .true. else last_iter = .false. endif - if(CS%debug) call hchksum(CS%h,"h at the start of new offline interval",G%HI) - if(CS%use_ALE_algorithm) then ! If this is the first iteration in the offline timestep, then we need to read in fields and ! perform the main advection. if (first_iter) then if(is_root_pe()) print *, "Reading in new offline fields" ! Read in new transport and other fields - call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & - temp_mean, salt_mean, fluxes, & - CS%use_ALE_algorithm) - ! Scale fields by the number of vertical iterations between reading fields - CS%offline_CSp%netMassIn = CS%offline_CSp%netMassIn*Initer_vert - CS%offline_CSp%netMassOut = CS%offline_CSp%netMassOut*Initer_vert - eatr = eatr*Initer_vert - ebtr = ebtr*Initer_vert - CS%offline_CSp%iter_no = 0 - - CS%tv%T(:,:,:) = temp_mean(:,:,:) - CS%tv%S(:,:,:) = salt_mean(:,:,:) + ! call update_transport_from_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & + ! CS%tv%T, CS%tv%S, fluxes, CS%use_ALE_algorithm) + ! call update_transport_from_arrays(CS%offline_CSp) + call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) - ! Perform offline diffusion if requested - if (.not. CS%offline_CSp%skip_diffusion) then - call tracer_hordiff(CS%h, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & - CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + ! Apply any fluxes into the ocean + call offline_fw_fluxes_into_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) + + if (.not.CS%diabatic_first) then + call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & + CS%h, uhtr, vhtr, converged=adv_converged) + + ! Redistribute any remaining transport + call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + + ! Perform offline diffusion if requested + if (.not. skip_diffusion) then + if (associated(CS%VarMix)) then + call pass_var(CS%h,G%Domain) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) + endif + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + endif endif endif - CS%offline_CSp%iter_no = CS%offline_CSp%iter_no + 1 ! The functions related to column physics of tracers is performed separately in ALE mode - fluxes%netMassIn(:,:) = CS%offline_CSp%netMassIn(:,:) - fluxes%netMassOut(:,:) = CS%offline_CSp%netMassOut(:,:) - call offline_diabatic_ale(fluxes, Time_start, Time_end, time_interval, CS%offline_CSp, & - CS%h, eatr, ebtr) - call pass_var(CS%h,G%Domain) - - ! Do the transport, the final ALE remappings, horizontal diffusion if it is - ! the last iteration + if (do_vertical) then + call offline_diabatic_ale(fluxes, Time_start, Time_end, CS%offline_CSp, CS%h, eatr, ebtr) + endif + + ! Last thing that needs to be done is the final ALE remapping if(last_iter) then - if(is_root_pe()) print *, "Last iteration of offline interval" - call ALE_main_offline(G, GV, CS%h, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%offline_CSp%dt_offline) + if (CS%diabatic_first) then + call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & + CS%h, uhtr, vhtr, converged=adv_converged) + + ! Redistribute any remaining transport and perform the remaining advection + call offline_redistribute_residual(CS%offline_CSp, CS%h, uhtr, vhtr, adv_converged) + ! Perform offline diffusion if requested + if (.not. skip_diffusion) then + if (associated(CS%VarMix)) then + call pass_var(CS%h,G%Domain) + call calc_resoln_function(CS%h, CS%tv, G, GV, CS%VarMix) + call calc_slope_functions(CS%h, CS%tv, REAL(dt_offline), G, GV, CS%VarMix) + endif + call tracer_hordiff(CS%h, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & + CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) + endif + endif - call offline_advection_ale(fluxes, Time_start, time_interval, CS%offline_CSp, id_clock_ALE, & - CS%h, uhtr, vhtr, converged=adv_converged) + if(is_root_pe()) print *, "Last iteration of offline interval" - ! Redistribute any remaining transport - call offline_redistribute_residual(CS%offline_CSp, CS%h, h_end, uhtr, vhtr, adv_converged) + ! Apply freshwater fluxes out of the ocean + call offline_fw_fluxes_out_ocean(G, GV, CS%offline_CSp, fluxes, CS%h) + ! These diagnostic can be used to identify which grid points did not converge within + ! the specified number of advection sub iterations + call post_offline_convergence_diags(CS%offline_CSp, CS%h, h_end, uhtr, vhtr) ! Call ALE one last time to make sure that tracers are remapped onto the layer thicknesses ! stored from the forward run call cpu_clock_begin(id_clock_ALE) - call ALE_offline_tracer_final( G, GV, CS%h, h_end, CS%tracer_Reg, CS%ALE_CSp) + call ALE_offline_tracer_final( G, GV, CS%h, CS%tv, h_end, CS%tracer_Reg, CS%ALE_CSp) call cpu_clock_end(id_clock_ALE) - call pass_var(CS%h,G%Domain) - - + call pass_var(CS%h, G%Domain) endif - else ! NON-ALE MODE...NOT WELL TESTED - call MOM_error(WARNING, & "Offline tracer mode in non-ALE configuration has not been thoroughly tested") ! Note that for the layer mode case, the calls to tracer sources and sinks is embedded in ! main_offline_advection_layer. Warning: this may not be appropriate for tracers that ! exchange with the atmosphere - if(time_interval .NE. CS%offline_CSp%dt_offline) then + if(time_interval .NE. dt_offline) then call MOM_error(FATAL, & "For offline tracer mode in a non-ALE configuration, dt_offline must equal time_interval") endif - call transport_by_files(G, GV, CS%offline_CSp, h_end, eatr, ebtr, uhtr, vhtr, & - temp_mean, salt_mean, fluxes) + call update_offline_fields(CS%offline_CSp, CS%h, fluxes, CS%use_ALE_algorithm) call offline_advection_layer(fluxes, Time_start, time_interval, CS%offline_CSp, & CS%h, eatr, ebtr, uhtr, vhtr) ! Perform offline diffusion if requested - if (.not. CS%offline_CSp%skip_diffusion) then - call tracer_hordiff(h_end, CS%offline_CSp%dt_offline, CS%MEKE, CS%VarMix, G, GV, & + if (.not. skip_diffusion) then + call tracer_hordiff(h_end, REAL(dt_offline), CS%MEKE, CS%VarMix, G, GV, & CS%tracer_diff_CSp, CS%tracer_Reg, CS%tv) endif - CS%tv%T = temp_mean - CS%tv%S = salt_mean CS%h = h_end - call pass_var(CS%tv%T,G%Domain) - call pass_var(CS%tv%S,G%Domain) - call pass_var(CS%h,G%Domain) + call pass_var(CS%tv%T, G%Domain) + call pass_var(CS%tv%S, G%Domain) + call pass_var(CS%h, G%Domain) endif call adjust_ssh_for_p_atm(CS, G, GV, CS%ave_ssh, fluxes%p_surf_SSH) call calculate_surface_state(state, CS%u, CS%v, CS%h, CS%ave_ssh, G, GV, CS) - call cpu_clock_end(id_clock_tracer) - call disable_averaging(CS%diag) - call pass_var(CS%tv%T,G%Domain) call pass_var(CS%tv%S,G%Domain) call pass_var(CS%h,G%Domain) fluxes%fluxes_used = .true. -end subroutine step_tracers + call cpu_clock_end(id_clock_offline_tracer) +end subroutine step_offline !> This subroutine initializes MOM. subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mode) @@ -2238,28 +2270,28 @@ subroutine initialize_MOM(Time, param_file, dirs, CS, Time_in, offline_tracer_mo cmor_long_name ="Sea Water Salinity") endif + ! This subroutine initializes any tracer packages. + new_sim = ((dirs%input_filename(1:1) == 'n') .and. & + (LEN_TRIM(dirs%input_filename) == 1)) + call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & + CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & + CS%ALE_sponge_CSp, CS%diag_to_Z_CSp, CS%tv) + + ! If running in offline tracer mode, initialize the necessary control structure and ! parameters if(present(offline_tracer_mode)) offline_tracer_mode=CS%offline_tracer_mode if(CS%offline_tracer_mode) then + ! Setup some initial parameterizations and also assign some of the subtypes call offline_transport_init(param_file, CS%offline_CSp, CS%diabatic_CSp, G, GV) - CS%offline_CSp%debug = CS%debug - if (mod(first_direction,2)==0) then - CS%offline_CSp%x_before_y = .true. - else - CS%offline_CSp%x_before_y = .false. - endif + call insert_offline_main( CS=CS%offline_CSp, ALE_CSp=CS%ALE_CSp, diabatic_CSp=CS%diabatic_CSp, & + diag=CS%diag, OBC=CS%OBC, tracer_adv_CSp=CS%tracer_adv_CSp, & + tracer_flow_CSp=CS%tracer_flow_CSp, tracer_Reg=CS%tracer_Reg, & + tv=CS%tv, x_before_y = (MOD(first_direction,2)==0), debug=CS%debug ) call register_diags_offline_transport(Time, CS%diag, CS%offline_CSp) endif - ! This subroutine initializes any tracer packages. - new_sim = ((dirs%input_filename(1:1) == 'n') .and. & - (LEN_TRIM(dirs%input_filename) == 1)) - call tracer_flow_control_init(.not.new_sim, Time, G, GV, CS%h, param_file, & - CS%diag, CS%OBC, CS%tracer_flow_CSp, CS%sponge_CSp, & - CS%ALE_sponge_CSp, CS%diag_to_Z_CSp, CS%tv) - call cpu_clock_begin(id_clock_pass_init) !--- set up group pass for u,v,T,S and h. pass_uv_T_S_h also is used in step_MOM @@ -2531,6 +2563,10 @@ subroutine register_diags(Time, G, GV, CS, ADp) endif endif + ! fields posted prior to dynamics step + CS%id_h_pre_dyn = register_diag_field('ocean_model', 'h_pre_dyn', diag%axesTL, Time, & + 'Layer Thickness before dynamics step', thickness_units) + ! diagnostics for values prior to diabatic and prior to ALE CS%id_u_predia = register_diag_field('ocean_model', 'u_predia', diag%axesCuL, Time, & 'Zonal velocity before diabatic forcing', 'meter second-1') @@ -2735,6 +2771,7 @@ subroutine MOM_timing_init(CS) id_clock_diabatic = cpu_clock_id('(Ocean diabatic driver)', grain=CLOCK_MODULE_DRIVER) id_clock_continuity = cpu_clock_id('(Ocean continuity equation *)', grain=CLOCK_MODULE) + id_clock_BBL_visc = cpu_clock_id('(Ocean set BBL viscosity)', grain=CLOCK_MODULE) id_clock_pass = cpu_clock_id('(Ocean message passing *)', grain=CLOCK_MODULE) id_clock_MOM_init = cpu_clock_id('(Ocean MOM_initialize_state)', grain=CLOCK_MODULE) id_clock_pass_init = cpu_clock_id('(Ocean init message passing *)', grain=CLOCK_ROUTINE) @@ -2745,6 +2782,9 @@ subroutine MOM_timing_init(CS) id_clock_diagnostics = cpu_clock_id('(Ocean collective diagnostics)', grain=CLOCK_MODULE) id_clock_Z_diag = cpu_clock_id('(Ocean Z-space diagnostics)', grain=CLOCK_MODULE) id_clock_ALE = cpu_clock_id('(Ocean ALE)', grain=CLOCK_MODULE) + if(CS%offline_tracer_mode) then + id_clock_offline_tracer = cpu_clock_id('Ocean offline tracers', grain=CLOCK_SUBCOMPONENT) + endif end subroutine MOM_timing_init @@ -3724,6 +3764,10 @@ subroutine MOM_end(CS) call tracer_registry_end(CS%tracer_Reg) call tracer_flow_control_end(CS%tracer_flow_CSp) + if(CS%offline_tracer_mode) then + call offline_transport_end(CS%offline_CSp) + endif + DEALLOC_(CS%uhtr) ; DEALLOC_(CS%vhtr) if (CS%split) then ; if (CS%legacy_split) then call end_dyn_legacy_split(CS%dyn_legacy_split_CSp) @@ -4170,3 +4214,4 @@ end subroutine MOM_end end module MOM + diff --git a/src/core/MOM_CoriolisAdv.F90 b/src/core/MOM_CoriolisAdv.F90 index 311551bca2..6f6967a5fb 100644 --- a/src/core/MOM_CoriolisAdv.F90 +++ b/src/core/MOM_CoriolisAdv.F90 @@ -140,13 +140,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) real, dimension(SZIB_(G),SZJ_(G)) :: & hArea_u, & ! The cell area weighted thickness interpolated to u points ! times the effective areas, in H m2. - KEx ! The zonal gradient of Kinetic energy per unit mass, + KEx, & ! The zonal gradient of Kinetic energy per unit mass, ! KEx = d/dx KE, in m s-2. + uh_center ! centered u times h at u-points real, dimension(SZI_(G),SZJB_(G)) :: & hArea_v, & ! The cell area weighted thickness interpolated to v points ! times the effective areas, in H m2. - KEy ! The meridonal gradient of Kinetic energy per unit mass, + KEy, & ! The meridonal gradient of Kinetic energy per unit mass, ! KEy = d/dy KE, in m s-2. + vh_center ! centered v times h at v-points real, dimension(SZI_(G),SZJ_(G)) :: & uh_min, uh_max, & ! The smallest and largest estimates of the volume vh_min, vh_max, & ! fluxes through the faces (i.e. u*h*dy & v*h*dx), @@ -246,6 +248,14 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) do j=Jsq-1,Jeq+2 ; do I=Isq-1,Ieq+1 hArea_u(I,j) = 0.5*(Area_h(i,j) * h(i,j,k) + Area_h(i+1,j) * h(i+1,j,k)) enddo ; enddo + if (CS%Coriolis_En_Dis) then + do j=Jsq,Jeq+1 ; do I=is-1,ie + uh_center(I,j) = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + enddo ; enddo + do J=js-1,je ; do i=Isq,Ieq+1 + vh_center(i,J) = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + enddo ; enddo + endif ! Adjust circulation components to relative vorticity and thickness projected onto ! velocity points on open boundaries. @@ -268,6 +278,16 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) hArea_v(i,J) = 0.5 * (Area_h(i,j) + Area_h(i,j+1)) * h(i,j+1,k) endif enddo + + if (CS%Coriolis_En_Dis) then + do i = max(Isq-1,OBC%segment(n)%HI%isd), min(Ieq+2,OBC%segment(n)%HI%ied) + if (OBC%segment(n)%direction == OBC_DIRECTION_N) then + vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j,k) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_S) + vh_center(i,J) = G%dx_Cv(i,J) * v(i,J,k) * h(i,j+1,k) + endif + enddo + endif elseif (OBC%segment(n)%is_E_or_W .and. (I >= Isq-1) .and. (I <= Ieq+1)) then if (OBC%zero_vorticity) then ; do J=OBC%segment(n)%HI%JsdB,OBC%segment(n)%HI%JedB dvdx(I,J) = 0. ; dudy(I,J) = 0. @@ -284,6 +304,15 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) hArea_u(I,j) = 0.5*(Area_h(i,j) + Area_h(i+1,j)) * h(i+1,j,k) endif enddo + if (CS%Coriolis_En_Dis) then + do j = max(Jsq-1,OBC%segment(n)%HI%jsd), min(Jeq+2,OBC%segment(n)%HI%jed) + if (OBC%segment(n)%direction == OBC_DIRECTION_E) then + uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i,j,k) + else ! (OBC%segment(n)%direction == OBC_DIRECTION_W) + uh_center(I,j) = G%dy_Cu(I,j) * u(I,j,k) * h(i+1,j,k) + endif + enddo + endif endif enddo ; endif @@ -441,7 +470,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) c1 = 1.0-1.5*0.5 ; c2 = 1.0-0.5 ; c3 = 2.0 ; slope = 0.5 do j=Jsq,Jeq+1 ; do I=is-1,ie - uhc = 0.5 * (G%dy_Cu(I,j) * u(I,j,k)) * (h(i,j,k) + h(i+1,j,k)) + uhc = uh_center(I,j) uhm = uh(I,j,k) ! This sometimes matters with some types of open boundary conditions. if (G%dy_Cu(I,j) == 0.0) uhc = uhm @@ -462,7 +491,7 @@ subroutine CorAdCalc(u, v, h, uh, vh, CAu, CAv, OBC, AD, G, GV, CS) endif enddo ; enddo do J=js-1,je ; do i=Isq,Ieq+1 - vhc = 0.5 * (G%dx_Cv(i,J) * v(i,J,k)) * (h(i,j,k) + h(i,j+1,k)) + vhc = vh_center(i,J) vhm = vh(i,J,k) ! This sometimes matters with some types of open boundary conditions. if (G%dx_Cv(i,J) == 0.0) vhc = vhm @@ -852,7 +881,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_CoriolisAdv" ! This module's name. + character(len=40) :: mdl = "MOM_CoriolisAdv" ! This module's name. character(len=20) :: tmpstr character(len=400) :: mesg integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz @@ -869,8 +898,8 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) CS%diag => diag ; CS%Time => Time ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "NOSLIP", CS%no_slip, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & "If true, no slip boundary conditions are used; otherwise \n"//& "free slip boundary conditions are assumed. The \n"//& "implementation of the free slip BCs on a C-grid is much \n"//& @@ -878,7 +907,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) "is strongly encouraged, and no slip BCs are not used with \n"//& "the biharmonic viscosity.", default=.false.) - call get_param(param_file, mod, "CORIOLIS_EN_DIS", CS%Coriolis_En_Dis, & + call get_param(param_file, mdl, "CORIOLIS_EN_DIS", CS%Coriolis_En_Dis, & "If true, two estimates of the thickness fluxes are used \n"//& "to estimate the Coriolis term, and the one that \n"//& "dissipates energy relative to the other one is used.", & @@ -886,7 +915,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) ! Set %Coriolis_Scheme ! (Select the baseline discretization for the Coriolis term) - call get_param(param_file, mod, "CORIOLIS_SCHEME", tmpstr, & + call get_param(param_file, mdl, "CORIOLIS_SCHEME", tmpstr, & "CORIOLIS_SCHEME selects the discretization for the \n"//& "Coriolis terms. Valid values are: \n"//& "\t SADOURNY75_ENERGY - Sadourny, 1975; energy cons. \n"//& @@ -917,13 +946,13 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) "#define CORIOLIS_SCHEME "//trim(tmpstr)//" found in input file.") end select if (CS%Coriolis_Scheme == AL_BLEND) then - call get_param(param_file, mod, "CORIOLIS_BLEND_WT_LIN", CS%wt_lin_blend, & + call get_param(param_file, mdl, "CORIOLIS_BLEND_WT_LIN", CS%wt_lin_blend, & "A weighting value for the ratio of inverse thicknesses, \n"//& "beyond which the blending between Sadourny Energy and \n"//& "Arakawa & Hsu goes linearly to 0 when CORIOLIS_SCHEME \n"//& "is ARAWAKA_LAMB_BLEND. This must be between 1 and 1e-16.", & units="nondim", default=0.125) - call get_param(param_file, mod, "CORIOLIS_BLEND_F_EFF_MAX", CS%F_eff_max_blend, & + call get_param(param_file, mdl, "CORIOLIS_BLEND_F_EFF_MAX", CS%F_eff_max_blend, & "The factor by which the maximum effective Coriolis \n"//& "acceleration from any point can be increased when \n"//& "blending different discretizations with the \n"//& @@ -947,13 +976,13 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) "have no effect on the SADOURNY Coriolis scheme if it \n"//& "were possible to use centered difference thickness fluxes." endif - call get_param(param_file, mod, "BOUND_CORIOLIS", CS%bound_Coriolis, mesg, & + call get_param(param_file, mdl, "BOUND_CORIOLIS", CS%bound_Coriolis, mesg, & default=.false.) if ((CS%Coriolis_En_Dis .and. (CS%Coriolis_Scheme == SADOURNY75_ENERGY)) .or. & (CS%Coriolis_Scheme == ROBUST_ENSTRO)) CS%bound_Coriolis = .false. ! Set KE_Scheme (selects discretization of KE) - call get_param(param_file, mod, "KE_SCHEME", tmpstr, & + call get_param(param_file, mdl, "KE_SCHEME", tmpstr, & "KE_SCHEME selects the discretization for acceleration \n"//& "due to the kinetic energy gradient. Valid values are: \n"//& "\t KE_ARAKAWA, KE_SIMPLE_GUDONOV, KE_GUDONOV", & @@ -970,7 +999,7 @@ subroutine CoriolisAdv_init(Time, G, param_file, diag, AD, CS) end select ! Set PV_Adv_Scheme (selects discretization of PV advection) - call get_param(param_file, mod, "PV_ADV_SCHEME", tmpstr, & + call get_param(param_file, mdl, "PV_ADV_SCHEME", tmpstr, & "PV_ADV_SCHEME selects the discretization for PV \n"//& "advection. Valid values are: \n"//& "\t PV_ADV_CENTERED - centered (aka Sadourny, 75) \n"//& diff --git a/src/core/MOM_PressureForce.F90 b/src/core/MOM_PressureForce.F90 index 0063fc6592..32ccdba726 100644 --- a/src/core/MOM_PressureForce.F90 +++ b/src/core/MOM_PressureForce.F90 @@ -78,7 +78,7 @@ subroutine PressureForce_init(Time, G, GV, param_file, diag, CS, tides_CSp) type(PressureForce_CS), pointer :: CS !< Pressure force control structure type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tide control structure #include "version_variable.h" - character(len=40) :: mod = "MOM_PressureForce" ! This module's name. + character(len=40) :: mdl = "MOM_PressureForce" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "PressureForce_init called with an associated "// & @@ -87,8 +87,8 @@ subroutine PressureForce_init(Time, G, GV, param_file, diag, CS, tides_CSp) else ; allocate(CS) ; endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ANALYTIC_FV_PGF", CS%Analytic_FV_PGF, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ANALYTIC_FV_PGF", CS%Analytic_FV_PGF, & "If true the pressure gradient forces are calculated \n"//& "with a finite volume form that analytically integrates \n"//& "the equations of state in pressure to avoid any \n"//& diff --git a/src/core/MOM_PressureForce_Montgomery.F90 b/src/core/MOM_PressureForce_Montgomery.F90 index a0fd36089f..d13c6c5b17 100644 --- a/src/core/MOM_PressureForce_Montgomery.F90 +++ b/src/core/MOM_PressureForce_Montgomery.F90 @@ -847,7 +847,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) logical :: use_temperature, use_EOS ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod ! This module's name. + character(len=40) :: mdl ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "PressureForce_init called with an associated "// & @@ -860,17 +860,17 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (associated(tides_CSp)) CS%tides_CSp => tides_CSp endif - mod = "MOM_PressureForce_Mont" - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + mdl = "MOM_PressureForce_Mont" + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "TIDES", CS%tides, & + call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "USE_EOS", use_EOS, default=.true., & + call get_param(param_file, mdl, "USE_EOS", use_EOS, default=.true., & do_not_log=.true.) ! Input for diagnostic use only. if (use_EOS) then @@ -896,7 +896,7 @@ subroutine PressureForce_Mont_init(Time, G, GV, param_file, diag, CS, tides_CSp) CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mod, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) end subroutine PressureForce_Mont_init diff --git a/src/core/MOM_PressureForce_analytic_FV.F90 b/src/core/MOM_PressureForce_analytic_FV.F90 index 6689459521..9e5e675b95 100644 --- a/src/core/MOM_PressureForce_analytic_FV.F90 +++ b/src/core/MOM_PressureForce_analytic_FV.F90 @@ -777,7 +777,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) type(tidal_forcing_CS), optional, pointer :: tides_CSp !< Tides control structure ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod ! This module's name. + character(len=40) :: mdl ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "PressureForce_init called with an associated "// & @@ -790,17 +790,17 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) if (associated(tides_CSp)) CS%tides_CSp => tides_CSp endif - mod = "MOM_PressureForce_AFV" - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + mdl = "MOM_PressureForce_AFV" + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "TIDES", CS%tides, & + call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "MASS_WEIGHT_IN_PRESSURE_GRADIENT", CS%useMassWghtInterp, & + call get_param(param_file, mdl, "MASS_WEIGHT_IN_PRESSURE_GRADIENT", CS%useMassWghtInterp, & "If true, use mass weighting when interpolation T/S for\n"//& "top/bottom integrals in AFV pressure gradient calculation.", default=.false.) @@ -812,7 +812,7 @@ subroutine PressureForce_AFV_init(Time, G, GV, param_file, diag, CS, tides_CSp) CS%GFS_scale = 1.0 if (GV%g_prime(1) /= GV%g_Earth) CS%GFS_scale = GV%g_prime(1) / GV%g_Earth - call log_param(param_file, mod, "GFS / G_EARTH", CS%GFS_scale) + call log_param(param_file, mdl, "GFS / G_EARTH", CS%GFS_scale) end subroutine PressureForce_AFV_init diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index e316a068f5..fb63d379b5 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -2007,6 +2007,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & enddo ; enddo endif if (apply_OBCs) then + !!! Not safe for wide halos... if (CS%BT_OBC%apply_u_OBCs) then ! copy back the value for u-points on the boundary. !GOMP parallel do default(none) shared(is,ie,js,je,ubt_sum_prev,ubt_sum,uhbt_sum_prev,& !GOMP uhbt_sum,ubt_wtd_prev,ubt_wtd) @@ -2076,7 +2077,7 @@ subroutine btstep(U_in, V_in, eta_in, dt, bc_accel_u, bc_accel_v, & ! Now calculate each layer's accelerations. if (apply_OBCs) then -! call open_boundary_set_bt_accel(OBC, G, u_accel_bt, v_accel_bt) + !!! Not safe for wide halos... if (CS%BT_OBC%apply_u_OBCs) then ; do j=js,je ; do I=is-1,ie if (OBC%segnum_u(I,j) /= OBC_NONE) then u_accel_bt(I,j) = (ubt_wtd(I,j) - ubt_first(I,j)) / dt @@ -2342,7 +2343,7 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, !! column mass anomaly, in m or kg m-2. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a barotropic step, !! m s-1. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of ubt in a barotropic step, + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of vbt in a barotropic step, !! m s-1. type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private barotropic arrays !! related to the open boundary conditions, @@ -2350,12 +2351,11 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, integer, intent(in) :: halo !< The extra halo size to use here. real, intent(in) :: dtbt !< The time step, in s. real, intent(in) :: bebt !< The fractional weighting of the future velocity - !! in - !! determining the transport. + !! in determining the transport. logical, intent(in) :: use_BT_cont !< If true, use the BT_cont_types to calculate !! transports. real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face areas at u points. - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at u points. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face areas at v points. type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u !< Structure of information used !! for a dynamic estimate of the face areas at !! u-points. @@ -2804,10 +2804,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D BT_OBC%Cg_u(I,j) = SQRT(GV%g_prime(1)*(0.5* & (G%bathyT(i,j) + G%bathyT(i+1,j)))) if (GV%Boussinesq) then - BT_OBC%H_u(I,j) = 0.5*((G%bathyT(i,j)*GV%m_to_H + eta(i,j)) + & - (G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j))) + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + BT_OBC%H_u(I,j) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + BT_OBC%H_u(I,j) = G%bathyT(i+1,j)*GV%m_to_H + eta(i+1,j) + endif else - BT_OBC%H_u(I,j) = 0.5*(eta(i,j) + eta(i+1,j)) + if (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_E) then + BT_OBC%H_u(i,j) = eta(i,j) + elseif (OBC%segment(OBC%segnum_u(I,j))%direction == OBC_DIRECTION_W) then + BT_OBC%H_u(i,j) = eta(i+1,j) + endif endif endif endif ; enddo ; enddo @@ -2850,10 +2857,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, D BT_OBC%Cg_v(i,J) = SQRT(GV%g_prime(1)*(0.5* & (G%bathyT(i,j) + G%bathyT(i,j+1)))) if (GV%Boussinesq) then - BT_OBC%H_v(i,J) = 0.5*((G%bathyT(i,j)*GV%m_to_H + eta(i,j)) + & - (G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1))) + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + BT_OBC%H_v(i,J) = G%bathyT(i,j)*GV%m_to_H + eta(i,j) + elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + BT_OBC%H_v(i,J) = G%bathyT(i,j+1)*GV%m_to_H + eta(i,j+1) + endif else - BT_OBC%H_v(i,J) = 0.5*(eta(i,j) + eta(i,j+1)) + if (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_N) then + BT_OBC%H_v(i,J) = eta(i,j) + elseif (OBC%segment(OBC%segnum_v(i,J))%direction == OBC_DIRECTION_S) then + BT_OBC%H_v(i,J) = eta(i,j+1) + endif endif endif endif ; enddo ; enddo @@ -3883,7 +3897,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & ! This include declares and sets the variable "version". #include "version_variable.h" ! Local variables - character(len=40) :: mod = "MOM_barotropic" ! This module's name. + character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)), Datv(SZI_(G),SZJBS_(G)) real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use @@ -3919,41 +3933,41 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "SPLIT", CS%split, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SPLIT", CS%split, & "Use the split time stepping if true.", default=.true.) if (.not.CS%split) return - call get_param(param_file, mod, "BOUND_BT_CORRECTION", CS%bound_BT_corr, & + call get_param(param_file, mdl, "BOUND_BT_CORRECTION", CS%bound_BT_corr, & "If true, the corrective pseudo mass-fluxes into the \n"//& "barotropic solver are limited to values that require \n"//& "less than maxCFL_BT_cont to be accommodated.",default=.false.) - call get_param(param_file, mod, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, & + call get_param(param_file, mdl, "BT_CONT_CORR_BOUNDS", CS%BT_cont_bounds, & "If true, and BOUND_BT_CORRECTION is true, use the \n"//& "BT_cont_type variables to set limits determined by \n"//& "MAXCFL_BT_CONT on the CFL number of the velocites \n"//& "that are likely to be driven by the corrective mass fluxes.", & default=.true.) !, do_not_log=.not.CS%bound_BT_corr) - call get_param(param_file, mod, "ADJUST_BT_CONT", CS%adjust_BT_cont, & + call get_param(param_file, mdl, "ADJUST_BT_CONT", CS%adjust_BT_cont, & "If true, adjust the curve fit to the BT_cont type \n"//& "that is used by the barotropic solver to match the \n"//& "transport about which the flow is being linearized.", default=.false.) - call get_param(param_file, mod, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & + call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & "If true, adjust the initial conditions for the \n"//& "barotropic solver to the values from the layered \n"//& "solution over a whole timestep instead of instantly. \n"//& "This is a decent approximation to the inclusion of \n"//& "sum(u dh_dt) while also correcting for truncation errors.", & default=.false.) - call get_param(param_file, mod, "BT_USE_VISC_REM_U_UH0", CS%visc_rem_u_uh0, & + call get_param(param_file, mdl, "BT_USE_VISC_REM_U_UH0", CS%visc_rem_u_uh0, & "If true, use the viscous remnants when estimating the \n"//& "barotropic velocities that were used to calculate uh0 \n"//& "and vh0. False is probably the better choice.", default=.false.) - call get_param(param_file, mod, "BT_USE_WIDE_HALOS", CS%use_wide_halos, & + call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", CS%use_wide_halos, & "If true, use wide halos and march in during the \n"//& "barotropic time stepping for efficiency.", default=.true., & layoutParam=.true.) - call get_param(param_file, mod, "BTHALO", bt_halo_sz, & + call get_param(param_file, mdl, "BTHALO", bt_halo_sz, & "The minimum halo size for the barotropic solver.", default=0, & layoutParam=.true.) #ifdef STATIC_MEMORY_ @@ -3964,38 +3978,38 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & #else wd_halos(1) = bt_halo_sz; wd_halos(2) = bt_halo_sz #endif - call log_param(param_file, mod, "!BT x-halo", wd_halos(1), & + call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), & "The barotropic x-halo size that is actually used.", & layoutParam=.true.) - call log_param(param_file, mod, "!BT y-halo", wd_halos(2), & + call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), & "The barotropic y-halo size that is actually used.", & layoutParam=.true.) - call get_param(param_file, mod, "USE_BT_CONT_TYPE", use_BT_cont_type, & + call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_BT_cont_type, & "If true, use a structure with elements that describe \n"//& "effective face areas from the summed continuity solver \n"//& "as a function the barotropic flow in coupling between \n"//& "the barotropic and baroclinic flow. This is only used \n"//& "if SPLIT is true. \n", default=.true.) - call get_param(param_file, mod, "NONLINEAR_BT_CONTINUITY", & + call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", & CS%Nonlinear_continuity, & "If true, use nonlinear transports in the barotropic \n"//& "continuity equation. This does not apply if \n"//& "USE_BT_CONT_TYPE is true.", default=.false.) CS%Nonlin_cont_update_period = 1 if (CS%Nonlinear_continuity) & - call get_param(param_file, mod, "NONLIN_BT_CONT_UPDATE_PERIOD", & + call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", & CS%Nonlin_cont_update_period, & "If NONLINEAR_BT_CONTINUITY is true, this is the number \n"//& "of barotropic time steps between updates to the face \n"//& "areas, or 0 to update only before the barotropic stepping.",& units="nondim", default=1) - call get_param(param_file, mod, "BT_MASS_SOURCE_LIMIT", CS%eta_source_limit, & + call get_param(param_file, mdl, "BT_MASS_SOURCE_LIMIT", CS%eta_source_limit, & "The fraction of the initial depth of the ocean that can \n"//& "be added to or removed from the bartropic solution \n"//& "within a thermodynamic time step. By default this is 0 \n"//& "for no correction.", units="nondim", default=0.0) - call get_param(param_file, mod, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& + call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project \n"//& "out the velocity tendancy by 1+BEBT when calculating the \n"//& "transport. The default (false) is to use a predictor \n"//& @@ -4004,36 +4018,36 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "average of the old and new velocities, with weights \n"//& "of (1-BEBT) and BEBT.", default=.false.) - call get_param(param_file, mod, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & + call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & "If true, add a dynamic pressure due to a viscous ice \n"//& "shelf, for instance.", default=.false.) if (CS%dynamic_psurf) then - call get_param(param_file, mod, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, & + call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, & "The length scale at which the Rayleigh damping rate due \n"//& "to the ice strength should be the same as if a Laplacian \n"//& "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", & units="m", default=1.0e4) - call get_param(param_file, mod, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & + call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & "The minimum depth to use in limiting the size of the \n"//& "dynamic surface pressure for stability, if \n"//& "DYNAMIC_SURFACE_PRESSURE is true..", units="m", & default=1.0e-6) - call get_param(param_file, mod, "CONST_DYN_PSURF", CS%const_dyn_psurf, & + call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, & "The constant that scales the dynamic surface pressure, \n"//& "if DYNAMIC_SURFACE_PRESSURE is true. Stable values \n"//& "are < ~1.0.", units="nondim", default=0.9) endif - call get_param(param_file, mod, "TIDES", CS%tides, & + call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "SADOURNY", CS%Sadourny, & + call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the \n"//& "Sadourny (1975) energy conserving scheme, otherwise \n"//& "the Arakawa & Hsu scheme is used. If the internal \n"//& "deformation radius is not resolved, the Sadourny scheme \n"//& "should probably be used.", default=.true.) - call get_param(param_file, mod, "BT_THICK_SCHEME", hvel_str, & + call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, & "A string describing the scheme that is used to set the \n"//& "open face areas used for barotropic transport and the \n"//& "relative weights of the accelerations. Valid values are:\n"//& @@ -4060,55 +4074,55 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & call MOM_error(FATAL, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//& "can only be used if USE_BT_CONT_TYPE is defined.") - call get_param(param_file, mod, "BT_STRONG_DRAG", CS%strong_drag, & + call get_param(param_file, mdl, "BT_STRONG_DRAG", CS%strong_drag, & "If true, use a stronger estimate of the retarding \n"//& "effects of strong bottom drag, by making it implicit \n"//& "with the barotropic time-step instead of implicit with \n"//& "the baroclinic time-step and dividing by the number of \n"//& "barotropic steps.", default=.false.) - call get_param(param_file, mod, "CLIP_BT_VELOCITY", CS%clip_velocity, & + call get_param(param_file, mdl, "CLIP_BT_VELOCITY", CS%clip_velocity, & "If true, limit any velocity components that exceed \n"//& "CFL_TRUNCATE. This should only be used as a desperate \n"//& "debugging measure.", default=.false.) - call get_param(param_file, mod, "CFL_TRUNCATE", CS%CFL_trunc, & + call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, & "The value of the CFL number that will cause velocity \n"//& "components to be truncated; instability can occur past 0.5.", & units="nondim", default=0.5, do_not_log=.not.CS%clip_velocity) - call get_param(param_file, mod, "MAXVEL", CS%maxvel, & + call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8, & do_not_log=.not.CS%clip_velocity) - call get_param(param_file, mod, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & + call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & "The maximum permitted CFL number associated with the \n"//& "barotropic accelerations from the summed velocities \n"//& "times the time-derivatives of thicknesses.", units="nondim", & default=0.25) - call get_param(param_file, mod, "DT_BT_FILTER", CS%dt_bt_filter, & + call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, & "A time-scale over which the barotropic mode solutions \n"//& "are filtered, in seconds if positive, or as a fraction \n"//& "of DT if negative. When used this can never be taken to \n"//& "be longer than 2*dt. Set this to 0 to apply no filtering.", & units="sec or nondim", default=-0.25) - call get_param(param_file, mod, "G_BT_EXTRA", CS%G_extra, & + call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, & "A nondimensional factor by which gtot is enhanced.", & units="nondim", default=0.0) - call get_param(param_file, mod, "SSH_EXTRA", SSH_extra, & + call get_param(param_file, mdl, "SSH_EXTRA", SSH_extra, & "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & units="m", default=min(10.0,0.05*G%max_depth)) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "DEBUG_BT", CS%debug_bt, & + call get_param(param_file, mdl, "DEBUG_BT", CS%debug_bt, & "If true, write out verbose debugging data within the \n"//& "barotropic time-stepping loop. The data volume can be \n"//& "quite large if this is true.", default=CS%debug) CS%linearized_BT_PV = .true. - call get_param(param_file, mod, "BEBT", CS%bebt, & + call get_param(param_file, mdl, "BEBT", CS%bebt, & "BEBT determines whether the barotropic time stepping \n"//& "uses the forward-backward time-stepping scheme or a \n"//& "backward Euler scheme. BEBT is valid in the range from \n"//& @@ -4116,7 +4130,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & "gravity waves) to 1 (for a backward Euler treatment). \n"//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) - call get_param(param_file, mod, "DTBT", CS%dtbt, & + call get_param(param_file, mdl, "DTBT", CS%dtbt, & "The barotropic time step, in s. DTBT is only used with \n"//& "the split explicit time stepping. To set the time step \n"//& "automatically based the maximum stable value use 0, or \n"//& @@ -4251,8 +4265,8 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & call set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) CS%dtbt = dtbt_input - call log_param(param_file, mod, "DTBT as used", CS%dtbt) - call log_param(param_file, mod, "estimated maximum DTBT", CS%dtbt_max) + call log_param(param_file, mdl, "DTBT as used", CS%dtbt) + call log_param(param_file, mdl, "estimated maximum DTBT", CS%dtbt_max) ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and ! initialized in register_barotropic_restarts. diff --git a/src/core/MOM_boundary_update.F90 b/src/core/MOM_boundary_update.F90 index 640ea1901e..d56f3ed589 100644 --- a/src/core/MOM_boundary_update.F90 +++ b/src/core/MOM_boundary_update.F90 @@ -43,7 +43,7 @@ module MOM_boundary_update integer :: id_clock_pass -character(len=40) :: mod = "MOM_boundary_update" ! This module's name. +character(len=40) :: mdl = "MOM_boundary_update" ! This module's name. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -56,7 +56,7 @@ subroutine call_OBC_register(param_file, CS, OBC) type(param_file_type), intent(in) :: param_file !< Parameter file to parse type(update_OBC_CS), pointer :: CS !< Control structure for OBCs type(ocean_OBC_type), pointer :: OBC !< Open boundary structure - character(len=40) :: mod = "MOM_boundary_update" ! This module's name. + character(len=40) :: mdl = "MOM_boundary_update" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "call_OBC_register called with an associated "// & @@ -64,18 +64,18 @@ subroutine call_OBC_register(param_file, CS, OBC) return else ; allocate(CS) ; endif - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "USE_FILE_OBC", CS%use_files, & + call get_param(param_file, mdl, "USE_FILE_OBC", CS%use_files, & "If true, use external files for the open boundary.", & default=.false.) - call get_param(param_file, mod, "USE_TIDAL_BAY_OBC", CS%use_tidal_bay, & + call get_param(param_file, mdl, "USE_TIDAL_BAY_OBC", CS%use_tidal_bay, & "If true, use the tidal_bay open boundary.", & default=.false.) - call get_param(param_file, mod, "USE_KELVIN_WAVE_OBC", CS%use_Kelvin, & + call get_param(param_file, mdl, "USE_KELVIN_WAVE_OBC", CS%use_Kelvin, & "If true, use the Kelvin wave open boundary.", & default=.false.) - call get_param(param_file, mod, "USE_SHELFWAVE_OBC", CS%use_shelfwave, & + call get_param(param_file, mdl, "USE_SHELFWAVE_OBC", CS%use_shelfwave, & "If true, use the shelfwave open boundary.", & default=.false.) @@ -110,7 +110,7 @@ subroutine update_OBC_data(OBC, G, GV, tv, h, CS, Time) integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB - character(len=40) :: mod = "update_OBC_data" ! This subroutine's name. + character(len=40) :: mdl = "update_OBC_data" ! This subroutine's name. character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke diff --git a/src/core/MOM_checksum_packages.F90 b/src/core/MOM_checksum_packages.F90 index d01e7f9639..9c59a4768a 100644 --- a/src/core/MOM_checksum_packages.F90 +++ b/src/core/MOM_checksum_packages.F90 @@ -52,16 +52,23 @@ module MOM_checksum_packages ! ============================================================================= subroutine MOM_state_chksum_5arg(mesg, u, v, h, uh, vh, G, GV, haloshift, symmetric) - character(len=*), intent(in) :: mesg - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + character(len=*), & + intent(in) :: mesg !< A message that appears on the chksum lines. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: uh !< Volume flux through zonal faces = u*h*dy, m3 s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: vh !< Volume flux through meridional + !! faces = v*h*dx, in m3 s-1. + integer, optional, intent(in) :: haloshift + logical, optional, intent(in) :: symmetric ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -89,14 +96,17 @@ end subroutine MOM_state_chksum_5arg ! ============================================================================= subroutine MOM_state_chksum_3arg(mesg, u, v, h, G, GV, haloshift, symmetric) - character(len=*), intent(in) :: mesg - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - integer, optional, intent(in) :: haloshift - logical, optional, intent(in) :: symmetric + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< Zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< Meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + integer, optional, intent(in) :: haloshift + logical, optional, intent(in) :: symmetric ! This subroutine writes out chksums for the model's basic state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. @@ -122,9 +132,10 @@ end subroutine MOM_state_chksum_3arg ! ============================================================================= subroutine MOM_thermo_chksum(mesg, tv, G, haloshift) - character(len=*), intent(in) :: mesg - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, optional, intent(in) :: haloshift ! This subroutine writes out chksums for the model's thermodynamic state ! variables. @@ -147,19 +158,39 @@ end subroutine MOM_thermo_chksum subroutine MOM_accel_chksum(mesg, CAu, CAv, PFu, PFv, diffu, diffv, G, GV, pbce, & u_accel_bt, v_accel_bt, symmetric) - character(len=*), intent(in) :: mesg - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: CAu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: CAv - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: PFu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: PFv - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: diffu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: diffv - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: pbce - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), optional, intent(in) :: u_accel_bt - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), optional, intent(in) :: v_accel_bt - logical, optional, intent(in) :: symmetric + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: CAu !< Zonal acceleration due to Coriolis + !! and momentum advection terms, in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: CAv !< Meridional acceleration due to Coriolis + !! and momentum advection terms, in m s-2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: PFu !< Zonal acceleration due to pressure gradients + !! (equal to -dM/dx) in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: PFv !< Meridional acceleration due to pressure gradients + !! (equal to -dM/dy) in m s-2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: diffu !< Zonal acceleration due to convergence of the + !! along-isopycnal stress tensor, in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: diffv !< Meridional acceleration due to convergence of + !! the along-isopycnal stress tensor, in m s-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: pbce !< The baroclinic pressure anomaly in each layer + !! due to free surface height anomalies, in + !! m s-2.pbce points to a space with nz layers + !! or NULL. !! NULL. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + optional, intent(in) :: u_accel_bt !< The zonal acceleration from terms in the + !! barotropic solver,in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + optional, intent(in) :: v_accel_bt !< The meridional acceleration from terms in + !! the barotropic solver,in m s-2. + logical, optional, intent(in) :: symmetric ! This subroutine writes out chksums for the model's accelerations. ! Arguments: mesg - A message that appears on the chksum lines. @@ -205,13 +236,24 @@ end subroutine MOM_accel_chksum ! ============================================================================= subroutine MOM_state_stats(mesg, u, v, h, Temp, Salt, G, allowChange, permitDiminishing) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - character(len=*), intent(in) :: mesg - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, pointer, dimension(:,:,:), intent(in) :: Temp, Salt - logical, optional, intent(in) :: allowChange, permitDiminishing + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + character(len=*), intent(in) :: mesg !< A message that appears on the chksum lines. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2). + real, pointer, dimension(:,:,:), & + intent(in) :: Temp !< Temperature in degree C. + real, pointer, dimension(:,:,:), & + intent(in) :: Salt !< Salinity, in ppt. + + logical, optional, intent(in) :: allowChange !< do not flag an error + !! if the statistics change. + logical, optional, & + intent(in) :: permitDiminishing !< do not flag error + !!if the extrema are diminishing. ! This subroutine monitors statistics for the model's state variables. ! Arguments: mesg - A message that appears on the chksum lines. ! (in) u - Zonal velocity, in m s-1. diff --git a/src/core/MOM_continuity.F90 b/src/core/MOM_continuity.F90 index a2a50594cd..3db43160d7 100644 --- a/src/core/MOM_continuity.F90 +++ b/src/core/MOM_continuity.F90 @@ -118,7 +118,7 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) type(continuity_CS), pointer :: CS !< Control structure for mom_continuity. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_continuity" ! This module's name. + character(len=40) :: mdl = "MOM_continuity" ! This module's name. character(len=20) :: tmpstr if (associated(CS)) then @@ -128,8 +128,8 @@ subroutine continuity_init(Time, G, GV, param_file, diag, CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CONTINUITY_SCHEME", tmpstr, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CONTINUITY_SCHEME", tmpstr, & "CONTINUITY_SCHEME selects the discretization for the \n"//& "continuity solver. The only valid value currently is: \n"//& "\t PPM - use a positive-definite (or monotonic) \n"//& diff --git a/src/core/MOM_continuity_PPM.F90 b/src/core/MOM_continuity_PPM.F90 index 31dc507800..b3635ca0b6 100644 --- a/src/core/MOM_continuity_PPM.F90 +++ b/src/core/MOM_continuity_PPM.F90 @@ -377,6 +377,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & h_in(i+1,j,k) = h_in(i,j,k) h_L(i+1,j,k) = h_in(i,j,k) h_R(i+1,j,k) = h_in(i,j,k) + h_R(i,j,k) = h_in(i,j,k) enddo ; enddo elseif (segment%direction == OBC_DIRECTION_W) then I=segment%HI%IsdB @@ -384,6 +385,7 @@ subroutine zonal_mass_flux(u, h_in, uh, dt, G, GV, CS, LB, uhbt, OBC, & h_in(i,j,k) = h_in(i+1,j,k) h_L(i,j,k) = h_in(i+1,j,k) h_R(i,j,k) = h_in(i+1,j,k) + h_L(i+1,j,k) = h_in(i+1,j,k) enddo ; enddo endif enddo @@ -1150,6 +1152,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & h_in(i,j+1,k) = h_in(i,j,k) h_L(i,j+1,k) = h_in(i,j,k) h_R(i,j+1,k) = h_in(i,j,k) + h_R(i,j,k) = h_in(i,j,k) enddo ; enddo elseif (segment%direction == OBC_DIRECTION_S) then J=segment%HI%JsdB @@ -1157,6 +1160,7 @@ subroutine meridional_mass_flux(v, h_in, vh, dt, G, GV, CS, LB, vhbt, OBC, & h_in(i,j,k) = h_in(i,j+1,k) h_L(i,j,k) = h_in(i,j+1,k) h_R(i,j,k) = h_in(i,j+1,k) + h_L(i,j+1,k) = h_in(i,j+1,k) enddo ; enddo endif enddo @@ -2108,7 +2112,7 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) type(continuity_PPM_CS), pointer :: CS !< Module's control structure. !> This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_continuity_PPM" ! This module's name. + character(len=40) :: mdl = "MOM_continuity_PPM" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "continuity_PPM_init called with associated control structure.") @@ -2117,12 +2121,12 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MONOTONIC_CONTINUITY", CS%monotonic, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MONOTONIC_CONTINUITY", CS%monotonic, & "If true, CONTINUITY_PPM uses the Colella and Woodward \n"//& "monotonic limiter. The default (false) is to use a \n"//& "simple positive definite limiter.", default=.false.) - call get_param(param_file, mod, "SIMPLE_2ND_PPM_CONTINUITY", CS%simple_2nd, & + call get_param(param_file, mdl, "SIMPLE_2ND_PPM_CONTINUITY", CS%simple_2nd, & "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& "(arithmetic mean) interpolation of the edge values. \n"//& "This may give better PV conservation propterties. While \n"//& @@ -2130,12 +2134,12 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "solver itself in the strongly advective limit, it does \n"//& "not reduce the overall order of accuracy of the dynamic \n"//& "core.", default=.false.) - call get_param(param_file, mod, "UPWIND_1ST_CONTINUITY", CS%upwind_1st, & + call get_param(param_file, mdl, "UPWIND_1ST_CONTINUITY", CS%upwind_1st, & "If true, CONTINUITY_PPM becomes a 1st-order upwind \n"//& "continuity solver. This scheme is highly diffusive \n"//& "but may be useful for debugging or in single-column \n"//& "mode where its minimal stencil is useful.", default=.false.) - call get_param(param_file, mod, "ETA_TOLERANCE", CS%tol_eta, & + call get_param(param_file, mdl, "ETA_TOLERANCE", CS%tol_eta, & "The tolerance for the differences between the \n"//& "barotropic and baroclinic estimates of the sea surface \n"//& "height due to the fluxes through each face. The total \n"//& @@ -2144,39 +2148,39 @@ subroutine continuity_PPM_init(Time, G, GV, param_file, diag, CS) "than about 10^-15*MAXIMUM_DEPTH.", units="m", & default=0.5*G%ke*GV%Angstrom_z) - call get_param(param_file, mod, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & + call get_param(param_file, mdl, "ETA_TOLERANCE_AUX", CS%tol_eta_aux, & "The tolerance for free-surface height discrepancies \n"//& "between the barotropic solution and the sum of the \n"//& "layer thicknesses when calculating the auxiliary \n"//& "corrected velocities. By default, this is the same as \n"//& "ETA_TOLERANCE, but can be made larger for efficiency.", & units="m", default=CS%tol_eta) - call get_param(param_file, mod, "VELOCITY_TOLERANCE", CS%tol_vel, & + call get_param(param_file, mdl, "VELOCITY_TOLERANCE", CS%tol_vel, & "The tolerance for barotropic velocity discrepancies \n"//& "between the barotropic solution and the sum of the \n"//& "layer thicknesses.", units="m s-1", default=3.0e8) ! The speed of light is the default. - call get_param(param_file, mod, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& + call get_param(param_file, mdl, "CONT_PPM_AGGRESS_ADJUST", CS%aggress_adjust,& "If true, allow the adjusted velocities to have a \n"//& "relative CFL change up to 0.5.", default=.false.) CS%vol_CFL = CS%aggress_adjust - call get_param(param_file, mod, "CONT_PPM_VOLUME_BASED_CFL", CS%vol_CFL, & + call get_param(param_file, mdl, "CONT_PPM_VOLUME_BASED_CFL", CS%vol_CFL, & "If true, use the ratio of the open face lengths to the \n"//& "tracer cell areas when estimating CFL numbers. The \n"//& "default is set by CONT_PPM_AGGRESS_ADJUST.", & default=CS%aggress_adjust, do_not_read=CS%aggress_adjust) - call get_param(param_file, mod, "CONTINUITY_CFL_LIMIT", CS%CFL_limit_adjust, & + call get_param(param_file, mdl, "CONTINUITY_CFL_LIMIT", CS%CFL_limit_adjust, & "The maximum CFL of the adjusted velocities.", units="nondim", & default=0.5) - call get_param(param_file, mod, "CONT_PPM_BETTER_ITER", CS%better_iter, & + call get_param(param_file, mdl, "CONT_PPM_BETTER_ITER", CS%better_iter, & "If true, stop corrective iterations using a velocity \n"//& "based criterion and only stop if the iteration is \n"//& "better than all predecessors.", default=.true.) - call get_param(param_file, mod, "CONT_PPM_USE_VISC_REM_MAX", & + call get_param(param_file, mdl, "CONT_PPM_USE_VISC_REM_MAX", & CS%use_visc_rem_max, & "If true, use more appropriate limiting bounds for \n"//& "corrections in strongly viscous columns.", default=.true.) - call get_param(param_file, mod, "CONT_PPM_MARGINAL_FACE_AREAS", CS%marginal_faces, & + call get_param(param_file, mdl, "CONT_PPM_MARGINAL_FACE_AREAS", CS%marginal_faces, & "If true, use the marginal face areas from the continuity \n"//& "solver for use as the weights in the barotropic solver. \n"//& "Otherwise use the transport averaged areas.", default=.true.) diff --git a/src/core/MOM_dynamics_legacy_split.F90 b/src/core/MOM_dynamics_legacy_split.F90 index 90a07bab1f..f12380bf5c 100644 --- a/src/core/MOM_dynamics_legacy_split.F90 +++ b/src/core/MOM_dynamics_legacy_split.F90 @@ -117,7 +117,7 @@ module MOM_dynamics_legacy_split use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units use MOM_verticalGrid, only : get_flux_units, get_tr_flux_units @@ -272,27 +272,60 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & Time_local, dt, fluxes, p_surf_begin, p_surf_end, & dt_since_flux, dt_therm, uh, vh, uhtr, vhtr, eta_av, & G, GV, CS, calc_dtbt, VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(vertvisc_type), intent(inout) :: visc - type(time_type), intent(in) :: Time_local - real, intent(in) :: dt !< The baroclinic dynamics time step, in s - type(forcing), intent(in) :: fluxes - real, dimension(:,:), pointer :: p_surf_begin, p_surf_end - real, intent(in) :: dt_since_flux, dt_therm - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av - type(MOM_dyn_legacy_split_CS), pointer :: CS - logical, intent(in) :: calc_dtbt - type(VarMix_CS), pointer :: VarMix - type(MEKE_type), pointer :: MEKE + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various. + !! thermodynamic variables. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical viscosities, + !! bottom drag viscosities, and related fields. + type(time_type), intent(in) :: Time_local !< The model time at the end + !! of the time step. + real, intent(in) :: dt !< The baroclinic dynamics time step, in s + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the + !! surface pressure at the beginning + !! of this dynamic step, in Pa. + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the + !! surface pressure at the end of + !! this dynamic step, in Pa. + real, intent(in) :: dt_since_flux !< The elapsed time since fluxes + !! were applied, in s. + real, intent(in) :: dt_therm !< The thermodynamic time step, in s. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< The meridional volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< The accumulated zonal volume or mass + !! transport since the last tracer advection, + !! in m3 or kg. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< The accumulated meridional volume or mass + !! transport since the last tracer advection, + !! in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), & + intent(out) :: eta_av !< The free surface height or column mass + !! time-averaged over a time step, + !! in m or kg m-2. + type(MOM_dyn_legacy_split_CS), & + pointer :: CS !< The control structure set up by + !! initialize_dyn_legacy_split. + logical, intent(in) :: calc_dtbt !< If true, recalculate the + !! barotropic time step. + type(VarMix_CS), pointer :: VarMix ! CS%taux_bot ; tauy_bot => CS%tauy_bot endif - if (visc%calc_bbl) then - ! Calculate the BBL properties and store them inside visc (u,h). - call cpu_clock_begin(id_clock_vertvisc) - call enable_averaging(visc%bbl_calc_time_interval, & - Time_local+set_time(int(visc%bbl_calc_time_interval-dt)), CS%diag) - call set_viscous_BBL(u, v, h, tv, visc, G, GV, CS%set_visc_CSp) - call disable_averaging(CS%diag) - call cpu_clock_end(id_clock_vertvisc) - - call cpu_clock_begin(id_clock_pass) - if (G%nonblocking_updates) then - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - pid_Ray = pass_vector_start(visc%Ray_u, visc%Ray_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & - pid_bbl_h = pass_vector_start(visc%bbl_thick_u, visc%bbl_thick_v, & - G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - pid_kv_bbl = pass_vector_start(visc%kv_bbl_u, visc%kv_bbl_v, & - G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - ! visc%calc_bbl will be set to .false. when the message passing is complete. - else - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call pass_vector(visc%Ray_u, visc%Ray_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then - call pass_vector(visc%bbl_thick_u, visc%bbl_thick_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE, complete=.false.) - call pass_vector(visc%kv_bbl_u, visc%kv_bbl_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - endif - visc%calc_bbl = .false. - endif - call cpu_clock_end(id_clock_pass) - endif - ! PFu = d/dx M(h,T,S) ! pbce = dM/deta if (CS%begw == 0.0) call enable_averaging(dt, Time_local, CS%diag) @@ -526,20 +523,6 @@ subroutine step_MOM_dyn_legacy_split(u, v, h, tv, visc, & if (G%nonblocking_updates) then call cpu_clock_begin(id_clock_pass) - if (visc%calc_bbl) then - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call pass_vector_complete(pid_Ray, visc%Ray_u, visc%Ray_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) & - call pass_vector_complete(pid_bbl_h, visc%bbl_thick_u, visc%bbl_thick_v, & - G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) & - call pass_vector_complete(pid_kv_bbl, visc%kv_bbl_u, visc%kv_bbl_v, & - G%Domain, To_All+SCALAR_PAIR, CGRID_NE) - - ! visc%calc_bbl is set to .false. now that the message passing is completed. - visc%calc_bbl = .false. - endif call pass_var_complete(pid_eta_PF, CS%eta_PF, G%Domain) call pass_var_complete(pid_eta, eta, G%Domain) if (CS%readjust_velocity) & @@ -1058,13 +1041,18 @@ end subroutine step_MOM_dyn_legacy_split ! ============================================================================= subroutine adjustments_dyn_legacy_split(u, v, h, dt, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, intent(in) :: dt !< The baroclinic dynamics time step, in s - type(MOM_dyn_legacy_split_CS), pointer :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, intent(in) :: dt !< The baroclinic dynamics time step, in s. + type(MOM_dyn_legacy_split_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_legacy_split. ! Arguments: u - The zonal velocity, in m s-1. ! (in) v - The meridional velocity, in m s-1. @@ -1112,13 +1100,20 @@ end subroutine adjustments_dyn_legacy_split ! ============================================================================= subroutine register_restarts_dyn_legacy_split(HI, GV, param_file, CS, restart_CS, uh, vh) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(MOM_dyn_legacy_split_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS - real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), target, intent(inout) :: uh - real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), target, intent(inout) :: vh + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(MOM_dyn_legacy_split_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_legacy_split. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart + !! control structure. + real, dimension(SZIB_(HI),SZJ_(HI),SZK_(GV)), & + target, intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), & + target, intent(inout) :: vh !< The meridional volume or mass + !! transport, in m3 s-1 or kg s-1. ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -1133,7 +1128,7 @@ subroutine register_restarts_dyn_legacy_split(HI, GV, param_file, CS, restart_CS ! (inout) vh - The meridional volume or mass transport, in m3 s-1 or kg s-1. type(vardesc) :: vd - character(len=40) :: mod = "MOM_dynamics_legacy_split" ! This module's name. + character(len=40) :: mdl = "MOM_dynamics_legacy_split" ! This module's name. character(len=48) :: thickness_units, flux_units logical :: adiabatic, flux_BT_coupling, readjust_BT_trans integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -1216,32 +1211,64 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ diag, CS, restart_CS, dt, Accel_diag, Cont_diag, MIS, & VarMix, MEKE, OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, visc, & dirs, ntrunc) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta - type(time_type), target, intent(in) :: Time - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(MOM_dyn_legacy_split_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS - real, intent(in) :: dt !< The baroclinic dynamics time step, in s - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag - type(ocean_internal_state), intent(inout) :: MIS - type(VarMix_CS), pointer :: VarMix - type(MEKE_type), pointer :: MEKE - type(ocean_OBC_type), pointer :: OBC - type(update_OBC_CS), pointer :: update_OBC_CSp - type(ALE_CS), pointer :: ALE_CSp - type(set_visc_CS), pointer :: setVisc_CSp - type(vertvisc_type), intent(inout) :: visc - type(directories), intent(in) :: dirs - integer, target, intent(inout) :: ntrunc + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & + intent(inout) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + target, intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + target, intent(inout) :: vh !< The meridional volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: eta !< The free surface height or column mass, + !! in m or kg m-2. + type(time_type), target, intent(in) :: Time !< The current model time. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(MOM_dyn_legacy_split_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_legacy_split. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control + !! structure. + real, intent(in) :: dt !< The baroclinic dynamics time step, + !! in s. + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag ! diag - call get_param(param_file, mod, "TIDES", use_tides, & + call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "BE", CS%be, & + call get_param(param_file, mdl, "BE", CS%be, & "If SPLIT is true, BE determines the relative weighting \n"//& "of a 2nd-order Runga-Kutta baroclinic time stepping \n"//& "scheme (0.5) and a backward Euler scheme (1) that is \n"//& @@ -1315,7 +1342,7 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ "from 0.5 to 1, but instability may occur near 0.5. \n"//& "BE is also applicable if SPLIT is false and USE_RK2 \n"//& "is true.", units="nondim", default=0.6) - call get_param(param_file, mod, "BEGW", CS%begw, & + call get_param(param_file, mdl, "BEGW", CS%begw, & "If SPLIT is true, BEGW is a number from 0 to 1 that \n"//& "controls the extent to which the treatment of gravity \n"//& "waves is forward-backward (0) or simulated backward \n"//& @@ -1324,29 +1351,29 @@ subroutine initialize_dyn_legacy_split(u, v, h, uh, vh, eta, Time, G, GV, param_ "between 0 and 0.5 to damp gravity waves.", & units="nondim", default=0.0) - call get_param(param_file, mod, "FLUX_BT_COUPLING", CS%flux_BT_coupling, & + call get_param(param_file, mdl, "FLUX_BT_COUPLING", CS%flux_BT_coupling, & "If true, use mass fluxes to ensure consistency between \n"//& "the baroclinic and barotropic modes. This is only used \n"//& "if SPLIT is true.", default=.false.) - call get_param(param_file, mod, "READJUST_BT_TRANS", CS%readjust_BT_trans, & + call get_param(param_file, mdl, "READJUST_BT_TRANS", CS%readjust_BT_trans, & "If true, make a barotropic adjustment to the layer \n"//& "velocities after the thermodynamic part of the step \n"//& "to ensure that the interaction between the thermodynamics \n"//& "and the continuity solver do not change the barotropic \n"//& "transport. This is only used if FLUX_BT_COUPLING and \n"//& "SPLIT are true.", default=.false.) - call get_param(param_file, mod, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & + call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & "If true, provide the bottom stress calculated by the \n"//& "vertical viscosity to the barotropic solver.", default=.false.) - call get_param(param_file, mod, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & + call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & "If true, use the summed layered fluxes plus an \n"//& "adjustment due to the change in the barotropic velocity \n"//& "in the barotropic continuity equation.", default=.true.) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "ADIABATIC", adiabatic, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., do_not_log=.true.) if (.not.CS%flux_BT_coupling .or. adiabatic) CS%readjust_BT_trans = .false. - call get_param(param_file, mod, "DEBUG_TRUNCATIONS", debug_truncations, & + call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & default=.false.) allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index 156d60d683..4d86e7f639 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -51,7 +51,7 @@ module MOM_dynamics_split_RK2 use MOM_open_boundary, only : ocean_OBC_type, radiation_open_bdry_conds use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef, vertvisc_remnant use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -175,8 +175,7 @@ module MOM_dynamics_split_RK2 type(ALE_CS), pointer :: ALE_CSp => NULL() ! for group halo pass - type(group_pass_type) :: pass_kv_bbl_thick - type(group_pass_type) :: pass_Ray_uv, pass_eta + type(group_pass_type) :: pass_eta type(group_pass_type) :: pass_visc_rem, pass_uvp type(group_pass_type) :: pass_hp_uv type(group_pass_type) :: pass_uv @@ -215,7 +214,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & type(forcing), intent(in) :: fluxes !< forcing fields real, dimension(:,:), pointer :: p_surf_begin !< surf pressure at start of this dynamic time step (Pa) real, dimension(:,:), pointer :: p_surf_end !< surf pressure at end of this dynamic time step (Pa) - real, intent(in) :: dt_since_flux !< elapesed time since fluxes were applied (sec) + real, intent(in) :: dt_since_flux !< elapsed time since fluxes were applied (sec) real, intent(in) :: dt_therm !< thermodynamic time step (sec) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), target, intent(inout) :: uh !< zonal volume/mass transport (m3/s or kg/s) real, dimension(SZI_(G),SZJB_(G),SZK_(G)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) @@ -282,7 +281,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & ! relative weightings of the layers in calculating ! the barotropic accelerations. !---For group halo pass - logical :: do_pass_Ray_uv, do_pass_kv_bbl_thick logical :: showCallTree, sym integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz @@ -340,30 +338,8 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & endif !--- begin set up for group halo pass - call cpu_clock_begin(id_clock_pass) - do_pass_Ray_uv = .FALSE. - if (.not.G%Domain%symmetric .and. visc%calc_bbl .AND. & - associated(visc%Ray_u) .and. associated(visc%Ray_v)) then - call create_group_pass(CS%pass_Ray_uv, visc%Ray_u, visc%Ray_v, G%Domain, & - To_North+To_East+SCALAR_PAIR+Omit_corners, CGRID_NE, halo=1) - do_pass_Ray_uv = .TRUE. - endif - do_pass_kv_bbl_thick = .FALSE. - if (.not.G%Domain%symmetric .and. visc%calc_bbl) then - if (associated(visc%bbl_thick_u) .and. associated(visc%bbl_thick_v)) then - call create_group_pass(CS%pass_kv_bbl_thick, visc%bbl_thick_u, visc%bbl_thick_v, & - G%Domain, To_North+To_East+SCALAR_PAIR+Omit_corners, & - CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then - call create_group_pass(CS%pass_kv_bbl_thick, visc%kv_bbl_u, visc%kv_bbl_v, & - G%Domain, To_North+To_East+SCALAR_PAIR+Omit_corners, & - CGRID_NE, halo=1) - do_pass_kv_bbl_thick = .TRUE. - endif - endif + call cpu_clock_begin(id_clock_pass) cont_stencil = continuity_stencil(CS%continuity_CSp) !### Apart from circle_OBCs halo for eta could be 1, but halo>=3 is required !### to match circle_OBCs solutions. Why? @@ -382,28 +358,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_end(id_clock_pass) !--- end set up for group halo pass - if (visc%calc_bbl) then - ! Calculate the BBL properties and store them inside visc (u,h). - call cpu_clock_begin(id_clock_vertvisc) - call enable_averaging(visc%bbl_calc_time_interval, & - Time_local+set_time(int(visc%bbl_calc_time_interval-dt)), CS%diag) - call set_viscous_BBL(u, v, h, tv, visc, G, GV, CS%set_visc_CSp) - call disable_averaging(CS%diag) - call cpu_clock_end(id_clock_vertvisc) - - call cpu_clock_begin(id_clock_pass) - if (G%nonblocking_updates) then - if (do_pass_Ray_uv) call start_group_pass(CS%pass_Ray_uv, G%Domain) - if (do_pass_kv_bbl_thick) call start_group_pass(CS%pass_kv_bbl_thick, G%Domain) - ! visc%calc_bbl will be set to .false. when the message passing is complete. - else - if (do_pass_Ray_uv) call do_group_pass(CS%pass_Ray_uv, G%Domain) - if (do_pass_kv_bbl_thick) call do_group_pass(CS%pass_kv_bbl_thick, G%Domain) - visc%calc_bbl = .false. - endif - call cpu_clock_end(id_clock_pass) - if (showCallTree) call callTree_wayPoint("done with set_viscous_BBL (step_MOM_dyn_split_RK2)") - endif ! PFu = d/dx M(h,T,S) ! pbce = dM/deta @@ -466,18 +420,6 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call check_redundant("pre-btstep u_bc_accel ", u_bc_accel, v_bc_accel, G) endif - if (G%nonblocking_updates) then - call cpu_clock_begin(id_clock_pass) - if (visc%calc_bbl) then - if (do_pass_Ray_uv) call complete_group_pass(CS%pass_Ray_uv, G%Domain) - if (do_pass_kv_bbl_thick) call complete_group_pass(CS%pass_kv_bbl_thick, G%Domain) - ! visc%calc_bbl is set to .false. now that the message passing is completed. - visc%calc_bbl = .false. - endif - call complete_group_pass(CS%pass_eta, G%Domain) - call cpu_clock_end(id_clock_pass) - endif - call cpu_clock_begin(id_clock_vertvisc) !$OMP parallel do default(shared) do k=1,nz @@ -505,6 +447,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, & call cpu_clock_begin(id_clock_pass) if (G%nonblocking_updates) then + call complete_group_pass(CS%pass_eta, G%Domain) call start_group_pass(CS%pass_visc_rem, G%Domain) else call do_group_pass(CS%pass_eta, G%Domain) @@ -916,7 +859,7 @@ subroutine register_restarts_dyn_split_RK2(HI, GV, param_file, CS, restart_CS, u real, dimension(SZI_(HI),SZJB_(HI),SZK_(GV)), target, intent(inout) :: vh !< merid volume/mass transport (m3/s or kg/s) type(vardesc) :: vd - character(len=40) :: mod = "MOM_dynamics_split_RK2" ! This module's name. + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -1010,7 +953,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil !! the velocity is truncated (this should be 0). real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h_tmp - character(len=40) :: mod = "MOM_dynamics_split_RK2" ! This module's name. + character(len=40) :: mdl = "MOM_dynamics_split_RK2" ! This module's name. character(len=48) :: thickness_units, flux_units type(group_pass_type) :: pass_h_tmp, pass_av_h_uvh logical :: use_tides, debug_truncations @@ -1032,9 +975,9 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil CS%diag => diag - call get_param(param_file, mod, "TIDES", use_tides, & + call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "BE", CS%be, & + call get_param(param_file, mdl, "BE", CS%be, & "If SPLIT is true, BE determines the relative weighting \n"//& "of a 2nd-order Runga-Kutta baroclinic time stepping \n"//& "scheme (0.5) and a backward Euler scheme (1) that is \n"//& @@ -1042,7 +985,7 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil "from 0.5 to 1, but instability may occur near 0.5. \n"//& "BE is also applicable if SPLIT is false and USE_RK2 \n"//& "is true.", units="nondim", default=0.6) - call get_param(param_file, mod, "BEGW", CS%begw, & + call get_param(param_file, mdl, "BEGW", CS%begw, & "If SPLIT is true, BEGW is a number from 0 to 1 that \n"//& "controls the extent to which the treatment of gravity \n"//& "waves is forward-backward (0) or simulated backward \n"//& @@ -1051,16 +994,16 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, param_fil "between 0 and 0.5 to damp gravity waves.", & units="nondim", default=0.0) - call get_param(param_file, mod, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & + call get_param(param_file, mdl, "SPLIT_BOTTOM_STRESS", CS%split_bottom_stress, & "If true, provide the bottom stress calculated by the \n"//& "vertical viscosity to the barotropic solver.", default=.false.) - call get_param(param_file, mod, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & + call get_param(param_file, mdl, "BT_USE_LAYER_FLUXES", CS%BT_use_layer_fluxes, & "If true, use the summed layered fluxes plus an \n"//& "adjustment due to the change in the barotropic velocity \n"//& "in the barotropic continuity equation.", default=.true.) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "DEBUG_TRUNCATIONS", debug_truncations, & + call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & default=.false.) allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 51c2db1361..12702f6604 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -107,7 +107,7 @@ module MOM_dynamics_unsplit use MOM_open_boundary, only : radiation_open_bdry_conds use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -183,25 +183,48 @@ module MOM_dynamics_unsplit subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, fluxes, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(vertvisc_type), intent(inout) :: visc - type(time_type), intent(in) :: Time_local - real, intent(in) :: dt !< The dynamics time step, in s. - type(forcing), intent(in) :: fluxes - real, dimension(:,:), pointer :: p_surf_begin, p_surf_end - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av - type(MOM_dyn_unsplit_CS), pointer :: CS - type(VarMix_CS), pointer :: VarMix - type(MEKE_type), pointer :: MEKE + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thicknesses, in H. + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + !! viscosities, bottom drag viscosities, and related fields. + type(time_type), intent(in) :: Time_local !< The model time at the end + !! of the time step. + real, intent(in) :: dt !< The dynamics time step, in s. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to + !! any possible forcing fields. Unused fields have NULL ptrs. + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to the + !! surface pressure at the beginning of this dynamic step, in Pa. + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to the + !! surface pressure at the end of this dynamic step, in Pa. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vh !< The meridional volume or mass + !! transport, in m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< he accumulated zonal volume or mass + !! transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< The accumulated meridional volume or + !! mass transport since the last tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height or + !! column mass, in m or kg m-2. + type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit. + type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with fields + !! that specify the spatially variable viscosities. + type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + !! fields related to the Mesoscale Eddy Kinetic Energy. ! Arguments: u - The input and output zonal velocity, in m s-1. ! (inout) v - The input and output meridional velocity, in m s-1. ! (inout) h - The input and output layer thicknesses, in m or kg m-2, @@ -354,26 +377,6 @@ subroutine step_MOM_dyn_unsplit(u, v, h, tv, visc, Time_local, dt, fluxes, & CS%diffu, CS%diffv, G, GV) endif -! visc contains viscosity and BBL thickness (u_in,h_in) - if (visc%calc_bbl) then - call enable_averaging(visc%bbl_calc_time_interval, & - Time_local+set_time(int(visc%bbl_calc_time_interval-dt)), CS%diag) - call set_viscous_BBL(u, v, h_av, tv, visc, G, GV, CS%set_visc_CSp) - call disable_averaging(CS%diag) - call cpu_clock_begin(id_clock_pass) - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call pass_vector(visc%Ray_u, visc%Ray_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then - call pass_vector(visc%bbl_thick_u, visc%bbl_thick_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE, complete=.false.) - call pass_vector(visc%kv_bbl_u, visc%kv_bbl_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - endif - call cpu_clock_end(id_clock_pass) - visc%calc_bbl = .false. - endif - ! up <- up + dt/2 d/dz visc d/dz up call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) @@ -560,11 +563,14 @@ end subroutine step_MOM_dyn_unsplit ! ============================================================================= subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(MOM_dyn_unsplit_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters. + type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. + ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -577,7 +583,7 @@ subroutine register_restarts_dyn_unsplit(HI, GV, param_file, CS, restart_CS) ! (inout) restart_CS - A pointer to the restart control structure. type(vardesc) :: vd - character(len=40) :: mod = "MOM_dynamics_unsplit" ! This module's name. + character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke @@ -609,26 +615,52 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(time_type), target, intent(in) :: Time - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(MOM_dyn_unsplit_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag - type(ocean_internal_state), intent(inout) :: MIS - type(ocean_OBC_type), pointer :: OBC - type(update_OBC_CS), pointer :: update_OBC_CSp - type(ALE_CS), pointer :: ALE_CSp - type(set_visc_CS), pointer :: setVisc_CSp - type(vertvisc_type), intent(inout) :: visc - type(directories), intent(in) :: dirs - integer, target, intent(inout) :: ntrunc + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , & + intent(inout) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(time_type), target, intent(in) :: Time !< The current model time. + type(param_file_type), intent(in) :: param_file !< A structure to parse + !! for run-time parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(MOM_dyn_unsplit_CS), pointer :: CS !< The control structure set up + !! by initialize_dyn_unsplit. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control + !!structure. + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the various + !! accelerations in the momentum equations, which can be used + !! for later derived diagnostics, like energy budgets. + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag !< A structure with pointers to + !! various terms in the continuity + !! equations. + type(ocean_internal_state), intent(inout) :: MIS !< The "MOM6 Internal State" + !! structure, used to pass around pointers + !! to various arrays for diagnostic purposes. + type(ocean_OBC_type), pointer :: OBC !< If open boundary conditions are + !! used, this points to the ocean_OBC_type + !! that was set up in MOM_initialization. + type(update_OBC_CS), pointer :: update_OBC_CSp !< If open boundary condition + !! updates are used, this points to + !! the appropriate control structure. + type(ALE_CS), pointer :: ALE_CSp !< This points to the ALE control + !! structure. + type(set_visc_CS), pointer :: setVisc_CSp !< This points to the set_visc + !! control structure. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + !! viscosities, bottom drag + !! viscosities, and related fields. + type(directories), intent(in) :: dirs !< A structure containing several + !! relevant directory paths. + integer, target, intent(inout) :: ntrunc !< A target for the variable that + !! records the number of times the velocity + !! is truncated (this should be 0). ! Arguments: u - The zonal velocity, in m s-1. ! (inout) v - The meridional velocity, in m s-1. @@ -663,7 +695,7 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & ! This subroutine initializes all of the variables that are used by this ! dynamic core, including diagnostics and the cpu clocks. - character(len=40) :: mod = "MOM_dynamics_unsplit" ! This module's name. + character(len=40) :: mdl = "MOM_dynamics_unsplit" ! This module's name. character(len=48) :: thickness_units, flux_units logical :: use_tides integer :: isd, ied, jsd, jed, nz, IsdB, IedB, JsdB, JedB @@ -681,9 +713,9 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, param_file, diag, CS, & CS%diag => diag - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "TIDES", use_tides, & + call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index a457d4d176..66ea1e4440 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -104,7 +104,7 @@ module MOM_dynamics_unsplit_RK2 use MOM_open_boundary, only : radiation_open_bdry_conds use MOM_open_boundary, only : open_boundary_zero_normal_flow use MOM_PressureForce, only : PressureForce, PressureForce_init, PressureForce_CS -use MOM_set_visc, only : set_viscous_BBL, set_viscous_ML, set_visc_CS +use MOM_set_visc, only : set_viscous_ML, set_visc_CS use MOM_tidal_forcing, only : tidal_forcing_init, tidal_forcing_CS use MOM_vert_friction, only : vertvisc, vertvisc_coef use MOM_vert_friction, only : vertvisc_limit_vel, vertvisc_init, vertvisc_CS @@ -189,25 +189,61 @@ module MOM_dynamics_unsplit_RK2 subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, fluxes, & p_surf_begin, p_surf_end, uh, vh, uhtr, vhtr, eta_av, G, GV, CS, & VarMix, MEKE) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u_in - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v_in - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_in - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(vertvisc_type), intent(inout) :: visc - type(time_type), intent(in) :: Time_local - real, intent(in) :: dt !< The baroclinic dynamics time step, in s. - type(forcing), intent(in) :: fluxes - real, dimension(:,:), pointer :: p_surf_begin, p_surf_end - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av - type(MOM_dyn_unsplit_RK2_CS), pointer :: CS - type(VarMix_CS), pointer :: VarMix - type(MEKE_type), pointer :: MEKE + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: u_in !< The input and output zonal + !! velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: v_in !< The input and output meridional + !! velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h_in !< The input and output layer + !! thicknesses, in m or kg m-2, depending on + !! whether the Boussinesq approximation is made. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(vertvisc_type), intent(inout) :: visc !< A structure containing vertical + !! viscosities, bottom drag + !! viscosities, and related fields. + type(time_type), intent(in) :: Time_local !< The model time at the end of + !! the time step. + real, intent(in) :: dt !< The baroclinic dynamics time step, + !! in s. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to + !! any possible forcing fields. Unused + !! fields have NULL ptrs. + real, dimension(:,:), pointer :: p_surf_begin !< A pointer (perhaps NULL) to + !! the surface pressure at the beginning + !! of this dynamic step, in Pa. + real, dimension(:,:), pointer :: p_surf_end !< A pointer (perhaps NULL) to + !! the surface pressure at the end of + !! this dynamic step, in Pa. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uh !< The zonal volume or mass transport, + !! in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vh !< The meridional volume or mass + !! transport, in m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: uhtr !< The accumulated zonal volume or + !! mass transport since the last + !! tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(inout) :: vhtr !< The accumulated meridional volume + !! or mass transport since the last + !! tracer advection, in m3 or kg. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_av !< The time-mean free surface height + !! or column mass, in m or kg m-2. + type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit_RK2. + type(VarMix_CS), pointer :: VarMix !< A pointer to a structure with + !! fields that specify the spatially + !! variable viscosities. + type(MEKE_type), pointer :: MEKE !< A pointer to a structure containing + !! fields related to the Mesoscale + !! Eddy Kinetic Energy. ! Arguments: u_in - The input and output zonal velocity, in m s-1. ! (inout) v_in - The input and output meridional velocity, in m s-1. ! (inout) h_in - The input and output layer thicknesses, in m or kg m-2, @@ -347,26 +383,6 @@ subroutine step_MOM_dyn_unsplit_RK2(u_in, v_in, h_in, tv, visc, Time_local, dt, call MOM_accel_chksum("Predictor 1 accel", CS%CAu, CS%CAv, CS%PFu, CS%PFv,& CS%diffu, CS%diffv, G, GV) -! visc contains viscosity and BBL thickness (u_in,h_in) - if (visc%calc_bbl) then - call enable_averaging(visc%bbl_calc_time_interval, & - Time_local+set_time(int(visc%bbl_calc_time_interval-dt)), CS%diag) - call set_viscous_BBL(u_in, v_in, h_av, tv, visc, G, GV, CS%set_visc_CSp) - call disable_averaging(CS%diag) - call cpu_clock_begin(id_clock_pass) - if (associated(visc%Ray_u) .and. associated(visc%Ray_v)) & - call pass_vector(visc%Ray_u, visc%Ray_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - if (associated(visc%kv_bbl_u) .and. associated(visc%kv_bbl_v)) then - call pass_vector(visc%bbl_thick_u, visc%bbl_thick_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE, complete=.false.) - call pass_vector(visc%kv_bbl_u, visc%kv_bbl_v, G%Domain, & - To_All+SCALAR_PAIR, CGRID_NE) - endif - call cpu_clock_end(id_clock_pass) - visc%calc_bbl = .false. - endif - ! up[n-1/2] <- up*[n-1/2] + dt/2 d/dz visc d/dz up[n-1/2] call cpu_clock_begin(id_clock_vertvisc) call enable_averaging(dt, Time_local, CS%diag) @@ -498,11 +514,14 @@ end subroutine step_MOM_dyn_unsplit_RK2 ! ============================================================================= subroutine register_restarts_dyn_unsplit_RK2(HI, GV, param_file, CS, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(MOM_dyn_unsplit_RK2_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up by + !! initialize_dyn_unsplit_RK2. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control + !! structure. ! This subroutine sets up any auxiliary restart variables that are specific ! to the unsplit time stepping scheme. All variables registered here should ! have the ability to be recreated if they are not present in a restart file. @@ -546,26 +565,51 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS restart_CS, Accel_diag, Cont_diag, MIS, & OBC, update_OBC_CSp, ALE_CSp, setVisc_CSp, & visc, dirs, ntrunc) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(time_type), target, intent(in) :: Time - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(MOM_dyn_unsplit_RK2_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS - type(accel_diag_ptrs), target, intent(inout) :: Accel_diag - type(cont_diag_ptrs), target, intent(inout) :: Cont_diag - type(ocean_internal_state), intent(inout) :: MIS - type(ocean_OBC_type), pointer :: OBC - type(update_OBC_CS), pointer :: update_OBC_CSp - type(ALE_CS), pointer :: ALE_CSp - type(set_visc_CS), pointer :: setVisc_CSp - type(vertvisc_type), intent(inout) :: visc - type(directories), intent(in) :: dirs - integer, target, intent(inout) :: ntrunc + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: v !< The meridional velocity, + !! in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(time_type), target, intent(in) :: Time !< The current model time. + type(param_file_type), intent(in) :: param_file !< A structure to parse + !! for run-time parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(MOM_dyn_unsplit_RK2_CS), pointer :: CS !< The control structure set up + !! by initialize_dyn_unsplit_RK2. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart + !! control structure. + type(accel_diag_ptrs), target, intent(inout) :: Accel_diag !< A set of pointers to the + !! various accelerations in the momentum equations, which can + !! be used for later derived diagnostics, like energy budgets. + type(cont_diag_ptrs), target, intent(inout) :: Cont_diag ! diag - call get_param(param_file, mod, "BE", CS%be, & + call get_param(param_file, mdl, "BE", CS%be, & "If SPLIT is true, BE determines the relative weighting \n"//& "of a 2nd-order Runga-Kutta baroclinic time stepping \n"//& "scheme (0.5) and a backward Euler scheme (1) that is \n"//& @@ -625,7 +669,7 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS "from 0.5 to 1, but instability may occur near 0.5. \n"//& "BE is also applicable if SPLIT is false and USE_RK2 \n"//& "is true.", units="nondim", default=0.6) - call get_param(param_file, mod, "BEGW", CS%begw, & + call get_param(param_file, mdl, "BEGW", CS%begw, & "If SPLIT is true, BEGW is a number from 0 to 1 that \n"//& "controls the extent to which the treatment of gravity \n"//& "waves is forward-backward (0) or simulated backward \n"//& @@ -633,9 +677,9 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, param_file, diag, CS "If SPLIT is false and USE_RK2 is true, BEGW can be \n"//& "between 0 and 0.5 to damp gravity waves.", & units="nondim", default=0.0) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "TIDES", use_tides, & + call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 diff --git a/src/core/MOM_forcing_type.F90 b/src/core/MOM_forcing_type.F90 index e6c00a35e6..ef453cc2b2 100644 --- a/src/core/MOM_forcing_type.F90 +++ b/src/core/MOM_forcing_type.F90 @@ -273,7 +273,7 @@ module MOM_forcing_type subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & DepthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h, T, netMassInOut, netMassOut, net_heat, net_salt, pen_SW_bnd, tv, & - aggregate_FW_forcing, nonpenSW) + aggregate_FW_forcing, nonpenSW, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid structure type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure @@ -317,6 +317,8 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real, dimension(SZI_(G)), optional, intent(out) :: nonpenSW !< non-downwelling SW; use in net_heat. !! Sum over SW bands when diagnosing nonpenSW. !! Units are (K * H). + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + !! diagnostics ! local real :: htot(SZI_(G)) ! total ocean depth (m for Bouss or kg/m^2 for non-Bouss) @@ -326,7 +328,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, real :: J_m2_to_H ! converts J/m^2 to H units (m for Bouss and kg/m^2 for non-Bouss) real :: Irho0 ! 1.0 / Rho0 real :: I_Cp ! 1.0 / C_p - + logical :: calculate_diags ! Indicate to calculate/update diagnostic arrays character(len=200) :: mesg integer :: is, ie, nz, i, k, n Ih_limit = 1.0 / DepthBeforeScalingFluxes @@ -336,6 +338,8 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, is = G%isc ; ie = G%iec ; nz = G%ke + calculate_diags = .true. + if (present(skip_diags)) calculate_diags = .not. skip_diags ! error checking @@ -447,7 +451,7 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! remove lrunoff*SST here, to counteract its addition elsewhere net_heat(i) = (net_heat(i) + (scale*(dt*J_m2_to_H)) * fluxes%heat_content_lrunoff(i,j)) - & (GV%kg_m2_to_H * (scale * dt)) * fluxes%lrunoff(i,j) * T(i,1) - if (ASSOCIATED(tv%TempxPmE)) then + if (calculate_diags .and. ASSOCIATED(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_lrunoff(i,j) - fluxes%lrunoff(i,j)*T(i,1)) endif @@ -459,13 +463,12 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! remove frunoff*SST here, to counteract its addition elsewhere net_heat(i) = net_heat(i) + (scale*(dt*J_m2_to_H)) * fluxes%heat_content_frunoff(i,j) - & (GV%kg_m2_to_H * (scale * dt)) * fluxes%frunoff(i,j) * T(i,1) - if (ASSOCIATED(tv%TempxPmE)) then + if (calculate_diags .and. ASSOCIATED(tv%TempxPmE)) then tv%TempxPmE(i,j) = tv%TempxPmE(i,j) + (scale * dt) * & (I_Cp*fluxes%heat_content_frunoff(i,j) - fluxes%frunoff(i,j)*T(i,1)) endif endif - ! smg: new code ! add heat from all terms that may add mass to the ocean (K * H). ! if evap, lprec, or vprec < 0, then compute their heat content @@ -510,102 +513,110 @@ subroutine extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, ! non-Bouss: (g/m^2) if (ASSOCIATED(fluxes%salt_flux)) then Net_salt(i) = (scale * dt * (1000.0 * fluxes%salt_flux(i,j))) * GV%kg_m2_to_H - fluxes%netSalt(i,j) = Net_salt(i) endif + ! Diagnostics follow... + if (calculate_diags) then + + ! Store Net_salt for unknown reason? + if (ASSOCIATED(fluxes%salt_flux)) then + if (calculate_diags) fluxes%netSalt(i,j) = Net_salt(i) + endif - ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or - ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. - if(ASSOCIATED(fluxes%heat_content_massin)) then - if (aggregate_FW_forcing) then - if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt - else ! net is "out" - fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + ! Initialize heat_content_massin that is diagnosed in mixedlayer_convection or + ! applyBoundaryFluxes such that the meaning is as the sum of all incoming components. + if (ASSOCIATED(fluxes%heat_content_massin)) then + if (aggregate_FW_forcing) then + if (netMassInOut(i) > 0.0) then ! net is "in" + fluxes%heat_content_massin(i,j) = -fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt + else ! net is "out" + fluxes%heat_content_massin(i,j) = fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + endif + else + fluxes%heat_content_massin(i,j) = 0. endif - else - fluxes%heat_content_massin(i,j) = 0. endif - endif - ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or - ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. - if(ASSOCIATED(fluxes%heat_content_massout)) then - if (aggregate_FW_forcing) then - if (netMassInOut(i) > 0.0) then ! net is "in" - fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt - else ! net is "out" - fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + ! Initialize heat_content_massout that is diagnosed in mixedlayer_convection or + ! applyBoundaryFluxes such that the meaning is as the sum of all outgoing components. + if (ASSOCIATED(fluxes%heat_content_massout)) then + if (aggregate_FW_forcing) then + if (netMassInOut(i) > 0.0) then ! net is "in" + fluxes%heat_content_massout(i,j) = fluxes%C_p * netMassOut(i) * T(i,1) * GV%H_to_kg_m2 / dt + else ! net is "out" + fluxes%heat_content_massout(i,j) = -fluxes%C_p * ( netMassInout(i) - netMassOut(i) ) * T(i,1) * GV%H_to_kg_m2 / dt + endif + else + fluxes%heat_content_massout(i,j) = 0.0 endif - else - fluxes%heat_content_massout(i,j) = 0.0 endif - endif - ! smg: we should remove sea ice melt from lprec!!! - ! fluxes%lprec > 0 means ocean gains mass via liquid precipitation and/or sea ice melt. - ! When atmosphere does not provide heat of this precipitation, the ocean assumes - ! it enters the ocean at the SST. - ! fluxes%lprec < 0 means ocean loses mass via sea ice formation. As we do not yet know - ! the layer at which this mass is removed, we cannot compute it heat content. We must - ! wait until MOM_diabatic_driver.F90. - if(ASSOCIATED(fluxes%heat_content_lprec)) then - if (fluxes%lprec(i,j) > 0.0) then - fluxes%heat_content_lprec(i,j) = fluxes%C_p*fluxes%lprec(i,j)*T(i,1) - else - fluxes%heat_content_lprec(i,j) = 0.0 + ! smg: we should remove sea ice melt from lprec!!! + ! fluxes%lprec > 0 means ocean gains mass via liquid precipitation and/or sea ice melt. + ! When atmosphere does not provide heat of this precipitation, the ocean assumes + ! it enters the ocean at the SST. + ! fluxes%lprec < 0 means ocean loses mass via sea ice formation. As we do not yet know + ! the layer at which this mass is removed, we cannot compute it heat content. We must + ! wait until MOM_diabatic_driver.F90. + if (ASSOCIATED(fluxes%heat_content_lprec)) then + if (fluxes%lprec(i,j) > 0.0) then + fluxes%heat_content_lprec(i,j) = fluxes%C_p*fluxes%lprec(i,j)*T(i,1) + else + fluxes%heat_content_lprec(i,j) = 0.0 + endif endif - endif - ! fprec SHOULD enter ocean at 0degC if atmos model does not provide fprec heat content. - ! However, we need to adjust netHeat above to reflect the difference between 0decC and SST - ! and until we do so fprec is treated like lprec and enters at SST. -AJA - if(ASSOCIATED(fluxes%heat_content_fprec)) then - if (fluxes%fprec(i,j) > 0.0) then - fluxes%heat_content_fprec(i,j) = fluxes%C_p*fluxes%fprec(i,j)*T(i,1) - else - fluxes%heat_content_fprec(i,j) = 0.0 + ! fprec SHOULD enter ocean at 0degC if atmos model does not provide fprec heat content. + ! However, we need to adjust netHeat above to reflect the difference between 0decC and SST + ! and until we do so fprec is treated like lprec and enters at SST. -AJA + if (ASSOCIATED(fluxes%heat_content_fprec)) then + if (fluxes%fprec(i,j) > 0.0) then + fluxes%heat_content_fprec(i,j) = fluxes%C_p*fluxes%fprec(i,j)*T(i,1) + else + fluxes%heat_content_fprec(i,j) = 0.0 + endif endif - endif - ! virtual precip associated with salinity restoring - ! vprec > 0 means add water to ocean, assumed to be at SST - ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 - if(ASSOCIATED(fluxes%heat_content_vprec)) then - if (fluxes%vprec(i,j) > 0.0) then - fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1) - else - fluxes%heat_content_vprec(i,j) = 0.0 + ! virtual precip associated with salinity restoring + ! vprec > 0 means add water to ocean, assumed to be at SST + ! vprec < 0 means remove water from ocean; set heat_content_vprec in MOM_diabatic_driver.F90 + if (ASSOCIATED(fluxes%heat_content_vprec)) then + if (fluxes%vprec(i,j) > 0.0) then + fluxes%heat_content_vprec(i,j) = fluxes%C_p*fluxes%vprec(i,j)*T(i,1) + else + fluxes%heat_content_vprec(i,j) = 0.0 + endif endif - endif - ! fluxes%evap < 0 means ocean loses mass due to evaporation. - ! Evaporation leaves ocean surface at a temperature that has yet to be determined, - ! since we do not know the precise layer that the water evaporates. We therefore - ! compute fluxes%heat_content_massout at the relevant point inside MOM_diabatic_driver.F90. - ! fluxes%evap > 0 means ocean gains moisture via condensation. - ! Condensation is assumed to drop into the ocean at the SST, just like lprec. - if(ASSOCIATED(fluxes%heat_content_cond)) then - if (fluxes%evap(i,j) > 0.0) then - fluxes%heat_content_cond(i,j) = fluxes%C_p*fluxes%evap(i,j)*T(i,1) - else - fluxes%heat_content_cond(i,j) = 0.0 + ! fluxes%evap < 0 means ocean loses mass due to evaporation. + ! Evaporation leaves ocean surface at a temperature that has yet to be determined, + ! since we do not know the precise layer that the water evaporates. We therefore + ! compute fluxes%heat_content_massout at the relevant point inside MOM_diabatic_driver.F90. + ! fluxes%evap > 0 means ocean gains moisture via condensation. + ! Condensation is assumed to drop into the ocean at the SST, just like lprec. + if (ASSOCIATED(fluxes%heat_content_cond)) then + if (fluxes%evap(i,j) > 0.0) then + fluxes%heat_content_cond(i,j) = fluxes%C_p*fluxes%evap(i,j)*T(i,1) + else + fluxes%heat_content_cond(i,j) = 0.0 + endif endif - endif - ! Liquid runoff enters ocean at SST if land model does not provide runoff heat content. - if (.not. useRiverHeatContent) then - if (ASSOCIATED(fluxes%lrunoff) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) then - fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*T(i,1) + ! Liquid runoff enters ocean at SST if land model does not provide runoff heat content. + if (.not. useRiverHeatContent) then + if (ASSOCIATED(fluxes%lrunoff) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) then + fluxes%heat_content_lrunoff(i,j) = fluxes%C_p*fluxes%lrunoff(i,j)*T(i,1) + endif endif - endif - ! Icebergs enter ocean at SST if land model does not provide calving heat content. - if (.not. useCalvingHeatContent) then - if (ASSOCIATED(fluxes%frunoff) .and. ASSOCIATED(fluxes%heat_content_frunoff)) then - fluxes%heat_content_frunoff(i,j) = fluxes%C_p*fluxes%frunoff(i,j)*T(i,1) + ! Icebergs enter ocean at SST if land model does not provide calving heat content. + if (.not. useCalvingHeatContent) then + if (ASSOCIATED(fluxes%frunoff) .and. ASSOCIATED(fluxes%heat_content_frunoff)) then + fluxes%heat_content_frunoff(i,j) = fluxes%C_p*fluxes%frunoff(i,j)*T(i,1) + endif endif - endif + + endif ! calculate_diags enddo ! i-loop @@ -677,9 +688,7 @@ end subroutine extractFluxes2d !! extractFluxes routine allows us to get "stuf per time" rather than the time integrated !! fluxes needed in other routines that call extractFluxes. subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, & - buoyancyFlux, netHeatMinusSW, netSalt ) - - + buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< surface fluxes @@ -692,7 +701,8 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, real, dimension(SZI_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoyancy flux (m^2/s^3) real, dimension(SZI_(G)), intent(inout) :: netHeatMinusSW !< surf Heat flux (K H/s) real, dimension(SZI_(G)), intent(inout) :: netSalt !< surf salt flux (ppt H/s) - + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + !! diagnostics inside extractFluxes1d() ! local variables integer :: nsw, start, npts, k real, parameter :: dt = 1. ! to return a rate from extractFluxes1d @@ -734,7 +744,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, call extractFluxes1d(G, GV, fluxes, optics, nsw, j, dt, & depthBeforeScalingFluxes, useRiverHeatContent, useCalvingHeatContent, & h(:,j,:), Temp(:,j,:), netH, netEvap, netHeatMinusSW, & - netSalt, penSWbnd, tv, .false.) + netSalt, penSWbnd, tv, .false., skip_diags=skip_diags) ! Sum over bands and attenuate as a function of depth ! netPen is the netSW as a function of depth @@ -750,7 +760,7 @@ subroutine calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, ! Add in the SW heating for purposes of calculating the net ! surface buoyancy flux affecting the top layer. - !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd(:,:), dim=1 ) + !netHeat(:) = netHeatMinusSW(:) + sum( penSWbnd, dim=1 ) netHeat(G%isc:G%iec) = netHeatMinusSW(G%isc:G%iec) + netPen(G%isc:G%iec,1) ! K H/s ! Convert to a buoyancy flux, excluding penetrating SW heating @@ -767,7 +777,7 @@ end subroutine calculateBuoyancyFlux1d !> Calculates surface buoyancy flux by adding up the heat, FW and salt fluxes, !! for 2d arrays. This is a wrapper for calculateBuoyancyFlux1d. subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & - buoyancyFlux, netHeatMinusSW, netSalt) + buoyancyFlux, netHeatMinusSW, netSalt, skip_diags) type(ocean_grid_type), intent(in) :: G !< ocean grid type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure type(forcing), intent(inout) :: fluxes !< surface fluxes @@ -779,7 +789,8 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(inout) :: buoyancyFlux !< buoy flux (m^2/s^3) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netHeatMinusSW !< surf temp flux (K H) real, dimension(SZI_(G),SZJ_(G)), optional, intent(inout) :: netSalt !< surf salt flux (ppt H) - + logical, optional, intent(in) :: skip_diags !< If present and true, skip calculating + !! diagnostics inside extractFluxes1d() ! local variables real, dimension( SZI_(G) ) :: netT ! net temperature flux (K m/s) real, dimension( SZI_(G) ) :: netS ! net saln flux (ppt m/s) @@ -788,10 +799,11 @@ subroutine calculateBuoyancyFlux2d(G, GV, fluxes, optics, h, Temp, Salt, tv, & netT(G%isc:G%iec) = 0. ; netS(G%isc:G%iec) = 0. !$OMP parallel do default(none) shared(G,GV,fluxes,optics,h,Temp,Salt,tv,buoyancyFlux,& -!$OMP netHeatMinusSW,netSalt) & +!$OMP netHeatMinusSW,netSalt,skip_diags) & !$OMP firstprivate(netT,netS) do j = G%jsc, G%jec - call calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), netT, netS ) + call calculateBuoyancyFlux1d(G, GV, fluxes, optics, h, Temp, Salt, tv, j, buoyancyFlux(:,j,:), & + netT, netS, skip_diags=skip_diags) if (present(netHeatMinusSW)) netHeatMinusSW(G%isc:G%iec,j) = netT(G%isc:G%iec) if (present(netSalt)) netSalt(G%isc:G%iec,j) = netS(G%isc:G%iec) enddo ! j @@ -1066,7 +1078,7 @@ subroutine register_forcing_type_diags(Time, diag, use_temperature, handles, use 'kilogram meter-2') handles%id_massin_flux = register_diag_field('ocean_model', 'massin_flux', diag%axesT1, Time, & - 'Net mass mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kilogram meter-2') + 'Net mass flux of freshwater into the ocean (used in boundary flux calculation)', 'kilogram meter-2') !========================================================================= ! area integrated surface mass transport @@ -1717,7 +1729,6 @@ subroutine mech_forcing_diags(fluxes, dt, G, diag, handles) type(diag_ctrl), intent(in) :: diag !< diagnostic type type(forcing_diags), intent(inout) :: handles !< diagnostic id for diag_manager - real, dimension(SZI_(G),SZJ_(G)) :: sum integer :: i,j,is,ie,js,je call cpu_clock_begin(handles%id_clock_forcing) @@ -1759,7 +1770,7 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) type(forcing_diags), intent(inout) :: handles !< diagnostic ids ! local - real, dimension(SZI_(G),SZJ_(G)) :: sum + real, dimension(SZI_(G),SZJ_(G)) :: res real :: total_transport ! for diagnosing integrated boundary transport real :: ave_flux ! for diagnosing averaged boundary flux real :: C_p ! seawater heat capacity (J/(deg K * kg)) @@ -1774,42 +1785,42 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) ppt2mks = 1e-3 is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - if (query_averaging_enabled(diag)) then - ! post the diagnostics for surface mass fluxes ================================== if (handles%id_prcme > 0 .or. handles%id_total_prcme > 0 .or. handles%id_prcme_ga > 0) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%lprec)) sum(:,:) = sum(:,:)+fluxes%lprec(:,:) - if (ASSOCIATED(fluxes%fprec)) sum(:,:) = sum(:,:)+fluxes%fprec(:,:) - ! fluxes%cond is not needed because it is derived from %evap > 0 - if (ASSOCIATED(fluxes%evap)) sum(:,:) = sum(:,:)+fluxes%evap(:,:) - if (ASSOCIATED(fluxes%lrunoff)) sum(:,:) = sum(:,:)+fluxes%lrunoff(:,:) - if (ASSOCIATED(fluxes%frunoff)) sum(:,:) = sum(:,:)+fluxes%frunoff(:,:) - if (ASSOCIATED(fluxes%vprec)) sum(:,:) = sum(:,:)+fluxes%vprec(:,:) - call post_data(handles%id_prcme, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + if (ASSOCIATED(fluxes%lprec)) res(i,j) = res(i,j)+fluxes%lprec(i,j) + if (ASSOCIATED(fluxes%fprec)) res(i,j) = res(i,j)+fluxes%fprec(i,j) + ! fluxes%cond is not needed because it is derived from %evap > 0 + if (ASSOCIATED(fluxes%evap)) res(i,j) = res(i,j)+fluxes%evap(i,j) + if (ASSOCIATED(fluxes%lrunoff)) res(i,j) = res(i,j)+fluxes%lrunoff(i,j) + if (ASSOCIATED(fluxes%frunoff)) res(i,j) = res(i,j)+fluxes%frunoff(i,j) + if (ASSOCIATED(fluxes%vprec)) res(i,j) = res(i,j)+fluxes%vprec(i,j) + enddo ; enddo + call post_data(handles%id_prcme, res, diag) if(handles%id_total_prcme > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_prcme, total_transport, diag) endif if(handles%id_prcme_ga > 0) then - ave_flux = global_area_mean(sum,G) + ave_flux = global_area_mean(res,G) call post_data(handles%id_prcme_ga, ave_flux, diag) endif endif if(handles%id_net_massout > 0 .or. handles%id_total_net_massout > 0) then - sum(:,:) = 0.0 do j=js,je ; do i=is,ie - if(fluxes%lprec(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%lprec(i,j) - if(fluxes%vprec(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%vprec(i,j) - if(fluxes%evap(i,j) < 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) + res(i,j) = 0.0 + if(fluxes%lprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if(fluxes%vprec(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) + if(fluxes%evap(i,j) < 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massout, sum, diag) + call post_data(handles%id_net_massout, res, diag) if(handles%id_total_net_massout > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massout, total_transport, diag) endif endif @@ -1817,17 +1828,16 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) if(handles%id_massout_flux > 0) call post_data(handles%id_massout_flux,fluxes%netMassOut,diag) if(handles%id_net_massin > 0 .or. handles%id_total_net_massin > 0) then - sum(:,:) = 0.0 do j=js,je ; do i=is,ie - sum(i,j) = sum(i,j) + fluxes%fprec(i,j) + fluxes%lrunoff(i,j) + fluxes%frunoff(i,j) - if(fluxes%lprec(i,j) > 0.0) sum(i,j) = sum(i,j) + fluxes%lprec(i,j) - if(fluxes%vprec(i,j) > 0.0) sum(i,j) = sum(i,j) + fluxes%vprec(i,j) + res(i,j) = fluxes%fprec(i,j) + fluxes%lrunoff(i,j) + fluxes%frunoff(i,j) + if(fluxes%lprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%lprec(i,j) + if(fluxes%vprec(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%vprec(i,j) ! fluxes%cond is not needed because it is derived from %evap > 0 - if(fluxes%evap(i,j) > 0.0) sum(i,j) = sum(i,j) + fluxes%evap(i,j) + if(fluxes%evap(i,j) > 0.0) res(i,j) = res(i,j) + fluxes%evap(i,j) enddo ; enddo - call post_data(handles%id_net_massin, sum, diag) + call post_data(handles%id_net_massin, res, diag) if(handles%id_total_net_massin > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_massin, total_transport, diag) endif endif @@ -1837,250 +1847,257 @@ subroutine forcing_diagnostics(fluxes, state, dt, G, diag, handles) if ((handles%id_evap > 0) .and. ASSOCIATED(fluxes%evap)) & call post_data(handles%id_evap, fluxes%evap, diag) if ((handles%id_total_evap > 0) .and. ASSOCIATED(fluxes%evap)) then - total_transport = global_area_integral(fluxes%evap(:,:),G) + total_transport = global_area_integral(fluxes%evap,G) call post_data(handles%id_total_evap, total_transport, diag) endif if ((handles%id_evap_ga > 0) .and. ASSOCIATED(fluxes%evap)) then - ave_flux = global_area_mean(fluxes%evap(:,:),G) + ave_flux = global_area_mean(fluxes%evap,G) call post_data(handles%id_evap_ga, ave_flux, diag) endif - if ((handles%id_precip > 0) .and. ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then - sum(:,:) = fluxes%lprec(:,:) + fluxes%fprec(:,:) - call post_data(handles%id_precip, sum, diag) - endif - if ((handles%id_total_precip > 0) .and. ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then - sum(:,:) = fluxes%lprec(:,:) + fluxes%fprec(:,:) - total_transport = global_area_integral(sum,G) - call post_data(handles%id_total_precip, total_transport, diag) - endif - if ((handles%id_precip_ga > 0) .and. ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then - sum(:,:) = fluxes%lprec(:,:) + fluxes%fprec(:,:) - ave_flux = global_area_mean(sum,G) - call post_data(handles%id_precip_ga, ave_flux, diag) + if (ASSOCIATED(fluxes%lprec) .and. ASSOCIATED(fluxes%fprec)) then + do j=js,je ; do i=is,ie + res(i,j) = fluxes%lprec(i,j) + fluxes%fprec(i,j) + enddo ; enddo + if (handles%id_precip > 0) call post_data(handles%id_precip, res, diag) + if (handles%id_total_precip > 0) then + total_transport = global_area_integral(res,G) + call post_data(handles%id_total_precip, total_transport, diag) + endif + if (handles%id_precip_ga > 0) then + ave_flux = global_area_mean(res,G) + call post_data(handles%id_precip_ga, ave_flux, diag) + endif endif - if ((handles%id_lprec > 0) .and. ASSOCIATED(fluxes%lprec)) & - call post_data(handles%id_lprec, fluxes%lprec, diag) - if ((handles%id_total_lprec > 0) .and. ASSOCIATED(fluxes%lprec)) then - total_transport = global_area_integral(fluxes%lprec(:,:),G) - call post_data(handles%id_total_lprec, total_transport, diag) - endif - if ((handles%id_lprec_ga > 0) .and. ASSOCIATED(fluxes%lprec)) then - sum(:,:) = fluxes%lprec(:,:) - ave_flux = global_area_mean(sum,G) - call post_data(handles%id_lprec_ga, ave_flux, diag) + if (ASSOCIATED(fluxes%lprec)) then + if (handles%id_lprec > 0) call post_data(handles%id_lprec, fluxes%lprec, diag) + if (handles%id_total_lprec > 0) then + total_transport = global_area_integral(fluxes%lprec,G) + call post_data(handles%id_total_lprec, total_transport, diag) + endif + if (handles%id_lprec_ga > 0) then + ave_flux = global_area_mean(fluxes%lprec,G) + call post_data(handles%id_lprec_ga, ave_flux, diag) + endif endif - if ((handles%id_fprec > 0) .and. ASSOCIATED(fluxes%fprec)) & - call post_data(handles%id_fprec, fluxes%fprec, diag) - if ((handles%id_total_fprec > 0) .and. ASSOCIATED(fluxes%fprec)) then - total_transport = global_area_integral(fluxes%fprec(:,:),G) - call post_data(handles%id_total_fprec, total_transport, diag) - endif - if ((handles%id_fprec_ga > 0) .and. ASSOCIATED(fluxes%fprec)) then - sum(:,:) = fluxes%fprec(:,:) - ave_flux = global_area_mean(sum,G) - call post_data(handles%id_fprec_ga, ave_flux, diag) + if (ASSOCIATED(fluxes%fprec)) then + if (handles%id_fprec > 0) call post_data(handles%id_fprec, fluxes%fprec, diag) + if (handles%id_total_fprec > 0) then + total_transport = global_area_integral(fluxes%fprec,G) + call post_data(handles%id_total_fprec, total_transport, diag) + endif + if (handles%id_fprec_ga > 0) then + ave_flux = global_area_mean(fluxes%fprec,G) + call post_data(handles%id_fprec_ga, ave_flux, diag) + endif endif - if ((handles%id_vprec > 0) .and. ASSOCIATED(fluxes%vprec)) & - call post_data(handles%id_vprec, fluxes%vprec, diag) - if ((handles%id_total_vprec > 0) .and. ASSOCIATED(fluxes%vprec)) then - total_transport = global_area_integral(fluxes%vprec(:,:),G) - call post_data(handles%id_total_vprec, total_transport, diag) - endif - if ((handles%id_vprec_ga > 0) .and. ASSOCIATED(fluxes%vprec)) then - sum(:,:) = fluxes%vprec(:,:) - ave_flux = global_area_mean(sum,G) - call post_data(handles%id_vprec_ga, ave_flux, diag) + if (ASSOCIATED(fluxes%vprec)) then + if (handles%id_vprec > 0) call post_data(handles%id_vprec, fluxes%vprec, diag) + if (handles%id_total_vprec > 0) then + total_transport = global_area_integral(fluxes%vprec,G) + call post_data(handles%id_total_vprec, total_transport, diag) + endif + if (handles%id_vprec_ga > 0) then + ave_flux = global_area_mean(fluxes%vprec,G) + call post_data(handles%id_vprec_ga, ave_flux, diag) + endif endif - if ((handles%id_lrunoff > 0) .and. ASSOCIATED(fluxes%lrunoff)) & - call post_data(handles%id_lrunoff, fluxes%lrunoff, diag) - if ((handles%id_total_lrunoff > 0) .and. ASSOCIATED(fluxes%lrunoff)) then - total_transport = global_area_integral(fluxes%lrunoff(:,:),G) - call post_data(handles%id_total_lrunoff, total_transport, diag) + if (ASSOCIATED(fluxes%lrunoff)) then + if (handles%id_lrunoff > 0) call post_data(handles%id_lrunoff, fluxes%lrunoff, diag) + if (handles%id_total_lrunoff > 0) then + total_transport = global_area_integral(fluxes%lrunoff,G) + call post_data(handles%id_total_lrunoff, total_transport, diag) + endif endif - if ((handles%id_frunoff > 0) .and. ASSOCIATED(fluxes%frunoff)) & - call post_data(handles%id_frunoff, fluxes%frunoff, diag) - if ((handles%id_total_frunoff > 0) .and. ASSOCIATED(fluxes%frunoff)) then - total_transport = global_area_integral(fluxes%frunoff(:,:),G) - call post_data(handles%id_total_frunoff, total_transport, diag) + if (ASSOCIATED(fluxes%frunoff)) then + if (handles%id_frunoff > 0) call post_data(handles%id_frunoff, fluxes%frunoff, diag) + if (handles%id_total_frunoff > 0) then + total_transport = global_area_integral(fluxes%frunoff,G) + call post_data(handles%id_total_frunoff, total_transport, diag) + endif endif - ! post diagnostics for boundary heat fluxes ==================================== if ((handles%id_heat_content_lrunoff > 0) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) & call post_data(handles%id_heat_content_lrunoff, fluxes%heat_content_lrunoff, diag) if ((handles%id_total_heat_content_lrunoff > 0) .and. ASSOCIATED(fluxes%heat_content_lrunoff)) then - total_transport = global_area_integral(fluxes%heat_content_lrunoff(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_lrunoff,G) call post_data(handles%id_total_heat_content_lrunoff, total_transport, diag) endif if ((handles%id_heat_content_frunoff > 0) .and. ASSOCIATED(fluxes%heat_content_frunoff)) & call post_data(handles%id_heat_content_frunoff, fluxes%heat_content_frunoff, diag) if ((handles%id_total_heat_content_frunoff > 0) .and. ASSOCIATED(fluxes%heat_content_frunoff)) then - total_transport = global_area_integral(fluxes%heat_content_frunoff(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_frunoff,G) call post_data(handles%id_total_heat_content_frunoff, total_transport, diag) endif if ((handles%id_heat_content_lprec > 0) .and. ASSOCIATED(fluxes%heat_content_lprec)) & call post_data(handles%id_heat_content_lprec, fluxes%heat_content_lprec, diag) if ((handles%id_total_heat_content_lprec > 0) .and. ASSOCIATED(fluxes%heat_content_lprec)) then - total_transport = global_area_integral(fluxes%heat_content_lprec(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_lprec,G) call post_data(handles%id_total_heat_content_lprec, total_transport, diag) endif if ((handles%id_heat_content_fprec > 0) .and. ASSOCIATED(fluxes%heat_content_fprec)) & call post_data(handles%id_heat_content_fprec, fluxes%heat_content_fprec, diag) if ((handles%id_total_heat_content_fprec > 0) .and. ASSOCIATED(fluxes%heat_content_fprec)) then - total_transport = global_area_integral(fluxes%heat_content_fprec(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_fprec,G) call post_data(handles%id_total_heat_content_fprec, total_transport, diag) endif if ((handles%id_heat_content_vprec > 0) .and. ASSOCIATED(fluxes%heat_content_vprec)) & call post_data(handles%id_heat_content_vprec, fluxes%heat_content_vprec, diag) if ((handles%id_total_heat_content_vprec > 0) .and. ASSOCIATED(fluxes%heat_content_vprec)) then - total_transport = global_area_integral(fluxes%heat_content_vprec(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_vprec,G) call post_data(handles%id_total_heat_content_vprec, total_transport, diag) endif if ((handles%id_heat_content_cond > 0) .and. ASSOCIATED(fluxes%heat_content_cond)) & call post_data(handles%id_heat_content_cond, fluxes%heat_content_cond, diag) if ((handles%id_total_heat_content_cond > 0) .and. ASSOCIATED(fluxes%heat_content_cond)) then - total_transport = global_area_integral(fluxes%heat_content_cond(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_cond,G) call post_data(handles%id_total_heat_content_cond, total_transport, diag) endif if ((handles%id_heat_content_massout > 0) .and. ASSOCIATED(fluxes%heat_content_massout)) & call post_data(handles%id_heat_content_massout, fluxes%heat_content_massout, diag) if ((handles%id_total_heat_content_massout > 0) .and. ASSOCIATED(fluxes%heat_content_massout)) then - total_transport = global_area_integral(fluxes%heat_content_massout(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_massout,G) call post_data(handles%id_total_heat_content_massout, total_transport, diag) endif if ((handles%id_heat_content_massin > 0) .and. ASSOCIATED(fluxes%heat_content_massin)) & call post_data(handles%id_heat_content_massin, fluxes%heat_content_massin, diag) if ((handles%id_total_heat_content_massin > 0) .and. ASSOCIATED(fluxes%heat_content_massin)) then - total_transport = global_area_integral(fluxes%heat_content_massin(:,:),G) + total_transport = global_area_integral(fluxes%heat_content_massin,G) call post_data(handles%id_total_heat_content_massin, total_transport, diag) endif if (handles%id_net_heat_coupler > 0 .or. handles%id_total_net_heat_coupler > 0 .or. handles%id_net_heat_coupler_ga > 0. ) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) - if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) - if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) - if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) - call post_data(handles%id_net_heat_coupler, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + if (ASSOCIATED(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (ASSOCIATED(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (ASSOCIATED(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (ASSOCIATED(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + enddo ; enddo + call post_data(handles%id_net_heat_coupler, res, diag) if(handles%id_total_net_heat_coupler > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_coupler, total_transport, diag) endif if(handles%id_net_heat_coupler_ga > 0) then - ave_flux = global_area_mean(sum,G) + ave_flux = global_area_mean(res,G) call post_data(handles%id_net_heat_coupler_ga, ave_flux, diag) endif endif if (handles%id_net_heat_surface > 0 .or. handles%id_total_net_heat_surface > 0 .or. handles%id_net_heat_surface_ga > 0. ) then - sum(:,:) = 0.0 - if (ASSOCIATED(fluxes%LW)) sum(:,:) = sum(:,:) + fluxes%LW(:,:) - if (ASSOCIATED(fluxes%latent)) sum(:,:) = sum(:,:) + fluxes%latent(:,:) - if (ASSOCIATED(fluxes%sens)) sum(:,:) = sum(:,:) + fluxes%sens(:,:) - if (ASSOCIATED(fluxes%SW)) sum(:,:) = sum(:,:) + fluxes%SW(:,:) - if (ASSOCIATED(state%frazil)) sum(:,:) = sum(:,:) + state%frazil(:,:) * I_dt - ! if (ASSOCIATED(state%TempXpme)) then - ! sum(:,:) = sum(:,:) + state%TempXpme(:,:) * fluxes%C_p * I_dt - ! else - if (ASSOCIATED(fluxes%heat_content_lrunoff)) sum(:,:) = sum(:,:) + fluxes%heat_content_lrunoff(:,:) - if (ASSOCIATED(fluxes%heat_content_frunoff)) sum(:,:) = sum(:,:) + fluxes%heat_content_frunoff(:,:) - if (ASSOCIATED(fluxes%heat_content_lprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_lprec(:,:) - if (ASSOCIATED(fluxes%heat_content_fprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_fprec(:,:) - if (ASSOCIATED(fluxes%heat_content_vprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_vprec(:,:) - if (ASSOCIATED(fluxes%heat_content_cond)) sum(:,:) = sum(:,:) + fluxes%heat_content_cond(:,:) - if (ASSOCIATED(fluxes%heat_content_massout)) sum(:,:) = sum(:,:) + fluxes%heat_content_massout(:,:) - ! endif - if (ASSOCIATED(fluxes%heat_added)) sum(:,:) = sum(:,:) + fluxes%heat_added(:,:) - call post_data(handles%id_net_heat_surface, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + if (ASSOCIATED(fluxes%LW)) res(i,j) = res(i,j) + fluxes%LW(i,j) + if (ASSOCIATED(fluxes%latent)) res(i,j) = res(i,j) + fluxes%latent(i,j) + if (ASSOCIATED(fluxes%sens)) res(i,j) = res(i,j) + fluxes%sens(i,j) + if (ASSOCIATED(fluxes%SW)) res(i,j) = res(i,j) + fluxes%SW(i,j) + if (ASSOCIATED(state%frazil)) res(i,j) = res(i,j) + state%frazil(i,j) * I_dt + ! if (ASSOCIATED(state%TempXpme)) then + ! res(i,j) = res(i,j) + state%TempXpme(i,j) * fluxes%C_p * I_dt + ! else + if (ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (ASSOCIATED(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (ASSOCIATED(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + ! endif + if (ASSOCIATED(fluxes%heat_added)) res(i,j) = res(i,j) + fluxes%heat_added(i,j) + enddo ; enddo + call post_data(handles%id_net_heat_surface, res, diag) if(handles%id_total_net_heat_surface > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_net_heat_surface, total_transport, diag) endif if(handles%id_net_heat_surface_ga > 0) then - ave_flux = global_area_mean(sum,G) + ave_flux = global_area_mean(res,G) call post_data(handles%id_net_heat_surface_ga, ave_flux, diag) endif endif if (handles%id_heat_content_surfwater > 0 .or. handles%id_total_heat_content_surfwater > 0) then - sum(:,:) = 0.0 - ! if (ASSOCIATED(state%TempXpme)) then - ! sum(:,:) = sum(:,:) + state%TempXpme(:,:) * fluxes%C_p * I_dt - ! else - if (ASSOCIATED(fluxes%heat_content_lrunoff)) sum(:,:) = sum(:,:) + fluxes%heat_content_lrunoff(:,:) - if (ASSOCIATED(fluxes%heat_content_frunoff)) sum(:,:) = sum(:,:) + fluxes%heat_content_frunoff(:,:) - if (ASSOCIATED(fluxes%heat_content_lprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_lprec(:,:) - if (ASSOCIATED(fluxes%heat_content_fprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_fprec(:,:) - if (ASSOCIATED(fluxes%heat_content_vprec)) sum(:,:) = sum(:,:) + fluxes%heat_content_vprec(:,:) - if (ASSOCIATED(fluxes%heat_content_cond)) sum(:,:) = sum(:,:) + fluxes%heat_content_cond(:,:) - if (ASSOCIATED(fluxes%heat_content_massout)) sum(:,:) = sum(:,:) + fluxes%heat_content_massout(:,:) - ! endif - call post_data(handles%id_heat_content_surfwater, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + ! if (ASSOCIATED(state%TempXpme)) then + ! res(i,j) = res(i,j) + state%TempXpme(i,j) * fluxes%C_p * I_dt + ! else + if (ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if (ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + if (ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if (ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if (ASSOCIATED(fluxes%heat_content_vprec)) res(i,j) = res(i,j) + fluxes%heat_content_vprec(i,j) + if (ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + if (ASSOCIATED(fluxes%heat_content_massout)) res(i,j) = res(i,j) + fluxes%heat_content_massout(i,j) + ! endif + enddo ; enddo + call post_data(handles%id_heat_content_surfwater, res, diag) if(handles%id_total_heat_content_surfwater > 0) then - total_transport = global_area_integral(sum,G) + total_transport = global_area_integral(res,G) call post_data(handles%id_total_heat_content_surfwater, total_transport, diag) endif endif ! for OMIP, hfrunoffds = heat content of liquid plus frozen runoff if (handles%id_hfrunoffds > 0) then - sum(:,:) = 0.0 - if(ASSOCIATED(fluxes%heat_content_lrunoff)) then - sum(:,:) = sum(:,:) + fluxes%heat_content_lrunoff(:,:) - endif - if(ASSOCIATED(fluxes%heat_content_frunoff)) then - sum(:,:) = sum(:,:) + fluxes%heat_content_frunoff(:,:) - endif - call post_data(handles%id_hfrunoffds, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + if(ASSOCIATED(fluxes%heat_content_lrunoff)) res(i,j) = res(i,j) + fluxes%heat_content_lrunoff(i,j) + if(ASSOCIATED(fluxes%heat_content_frunoff)) res(i,j) = res(i,j) + fluxes%heat_content_frunoff(i,j) + enddo ; enddo + call post_data(handles%id_hfrunoffds, res, diag) endif ! for OMIP, hfrainds = heat content of lprec + fprec + cond if (handles%id_hfrainds > 0) then - sum(:,:) = 0.0 - if(ASSOCIATED(fluxes%heat_content_lprec)) then - sum(:,:) = sum(:,:) + fluxes%heat_content_lprec(:,:) - endif - if(ASSOCIATED(fluxes%heat_content_fprec)) then - sum(:,:) = sum(:,:) + fluxes%heat_content_fprec(:,:) - endif - if(ASSOCIATED(fluxes%heat_content_cond)) then - sum(:,:) = sum(:,:) + fluxes%heat_content_cond(:,:) - endif - call post_data(handles%id_hfrainds, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = 0.0 + if(ASSOCIATED(fluxes%heat_content_lprec)) res(i,j) = res(i,j) + fluxes%heat_content_lprec(i,j) + if(ASSOCIATED(fluxes%heat_content_fprec)) res(i,j) = res(i,j) + fluxes%heat_content_fprec(i,j) + if(ASSOCIATED(fluxes%heat_content_cond)) res(i,j) = res(i,j) + fluxes%heat_content_cond(i,j) + enddo ; enddo + call post_data(handles%id_hfrainds, res, diag) endif if ((handles%id_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then - sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) - call post_data(handles%id_LwLatSens, sum, diag) + do j=js,je ; do i=is,ie + res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + enddo ; enddo + call post_data(handles%id_LwLatSens, res, diag) endif if ((handles%id_total_LwLatSens > 0) .and. ASSOCIATED(fluxes%lw) .and. & ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then - sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) - total_transport = global_area_integral(sum,G) + do j=js,je ; do i=is,ie + res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + enddo ; enddo + total_transport = global_area_integral(res,G) call post_data(handles%id_total_LwLatSens, total_transport, diag) endif if ((handles%id_LwLatSens_ga > 0) .and. ASSOCIATED(fluxes%lw) .and. & ASSOCIATED(fluxes%latent) .and. ASSOCIATED(fluxes%sens)) then - sum(:,:) = (fluxes%lw(:,:) + fluxes%latent(:,:)) + fluxes%sens(:,:) - ave_flux = global_area_mean(sum,G) + do j=js,je ; do i=is,ie + res(i,j) = (fluxes%lw(i,j) + fluxes%latent(i,j)) + fluxes%sens(i,j) + enddo ; enddo + ave_flux = global_area_mean(res,G) call post_data(handles%id_LwLatSens_ga, ave_flux, diag) endif diff --git a/src/core/MOM_interface_heights.F90 b/src/core/MOM_interface_heights.F90 index d8efbe8561..aa50373755 100644 --- a/src/core/MOM_interface_heights.F90 +++ b/src/core/MOM_interface_heights.F90 @@ -67,14 +67,25 @@ module MOM_interface_heights contains subroutine find_eta_3d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) - 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 !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: G_Earth - real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt - integer, optional, intent(in) :: halo_size + 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 !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to + !! various thermodynamic + !! variables. + real, intent(in) :: G_Earth !< Earth gravitational + !! acceleration (m/s2). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1), intent(out) :: eta !< layer interface heights + !! (meter). + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic + !! variable that gives the "correct" free surface height (Boussinesq) or total water + !! column mass per unit aread (non-Boussinesq). This is used to dilate the layer. + !! thicknesses when calculating interfaceheights, in H (m or kg m-2). + integer, optional, intent(in) :: halo_size !< width of halo points on + !! which to calculate eta. ! This subroutine determines the heights of all interfaces between layers, ! using the appropriate form for consistency with the calculation of the @@ -186,14 +197,24 @@ end subroutine find_eta_3d subroutine find_eta_2d(h, tv, G_Earth, G, GV, eta, eta_bt, halo_size) - 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 !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, intent(in) :: G_Earth - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt - integer, optional, intent(in) :: halo_size + 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 !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to + !! various thermodynamic + !! variables. + real, intent(in) :: G_Earth !< Earth gravitational + !! acceleration (m/s2). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta !< free surface height + !! relative to mean sea + !! level (z=0) (m). + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< optional barotropic + !! variable that gives the "correct" free surface height (Boussinesq) or total + !! water column mass per unit aread (non-Boussinesq), in H (m or kg m-2). + integer, optional, intent(in) :: halo_size !< width of halo points on + !! which to calculate eta. ! This subroutine determines the free surface height, using the appropriate ! form for consistency with the calculation of the pressure gradient forces. diff --git a/src/core/MOM_legacy_barotropic.F90 b/src/core/MOM_legacy_barotropic.F90 index cd97ac00fd..8eab427516 100644 --- a/src/core/MOM_legacy_barotropic.F90 +++ b/src/core/MOM_legacy_barotropic.F90 @@ -390,38 +390,102 @@ subroutine legacy_btstep(use_fluxes, U_in, V_in, eta_in, dt, bc_accel_u, bc_acce visc_rem_u, visc_rem_v, etaav, uhbt_out, vhbt_out, OBC, & BT_cont, eta_PF_start, & taux_bot, tauy_bot, uh0, vh0, u_uh0, v_vh0) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - logical, intent(in) :: use_fluxes - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_in - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_in - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_in - real, intent(in) :: dt !< The time increment over which to integrate, in s. - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: bc_accel_u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: bc_accel_v - type(forcing), intent(in) :: fluxes - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: pbce - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta_PF_in - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: U_Cor - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: V_Cor - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: accel_layer_u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: accel_layer_v - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: eta_out - real, dimension(SZIB_(G),SZJ_(G)), intent(out) :: uhbtav - real, dimension(SZI_(G),SZJB_(G)), intent(out) :: vhbtav - type(legacy_barotropic_CS), pointer :: CS - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: visc_rem_u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: visc_rem_v - real, dimension(SZI_(G),SZJ_(G)), intent(out), optional :: etaav - real, dimension(SZIB_(G),SZJ_(G)), intent(out), optional :: uhbt_out - real, dimension(SZI_(G),SZJB_(G)), intent(out), optional :: vhbt_out - type(ocean_OBC_type), pointer, optional :: OBC - type(BT_cont_type), pointer, optional :: BT_cont - real, dimension(:,:), pointer, optional :: eta_PF_start - real, dimension(:,:), pointer, optional :: taux_bot - real, dimension(:,:), pointer, optional :: tauy_bot - real, dimension(:,:,:), pointer, optional :: uh0, u_uh0 - real, dimension(:,:,:), pointer, optional :: vh0, v_vh0 + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + logical, intent(in) :: use_fluxes !< A logical indicating whether velocities + !! (false) or fluxes (true) are used to initialize the barotropic velocities. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: U_in !< The initial (3-D) zonal velocity or + !! volume or mass fluxes,depending on flux_form, in m s-1 or m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: V_in !< The initial (3-D) meridional velocity + !! or volume/mass fluxes, depending on flux_form, in m s-1 or m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: eta_in !< The initial barotropic free surface + !! height anomaly or column mass anomaly, in m or kg m-2. + real, & + intent(in) :: dt !< The time increment over which to + !! integrate, in s. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: bc_accel_u !< The zonal baroclinic accelerations, + !! in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: bc_accel_v !< The meridional baroclinic + !! accelerations, in m s-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields have NULL ptrs. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: pbce !< The baroclinic pressure anomaly in each + !! layer due to free surface height anomalies, in m2 H-1 s-2. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: eta_PF_in !< The 2-D eta field (either SSH anomaly + !! or column mass anomaly) that was used to calculate the input pressure gradient accelerations + !! (or its final value if eta_PF_start is provided, in m or kg m-2. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: U_Cor !< The (3-D) zonal- and meridional- + !! velocities or volume or mass fluxes used to calculate the Coriolis + !! terms in bc_accel_u and!! bc_accel_v, in m s-1 or m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: V_Cor !< The (3-D) zonal- and meridional- + !! velocities or volume or mass fluxes used to calculate the Coriolis + !! terms in bc_accel_u and bc_accel_v, in m s-1 or m3 s-1 or kg s-1. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: accel_layer_u !< The accelerations of each layer + !! due to the barotropic calculation, in m s-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: accel_layer_v !< The accelerations of each layer + !! due to the barotropic calculation, in m s-2. + real, dimension(SZI_(G),SZJ_(G)), & + intent(inout) :: eta_out !< The final barotropic free surface + !! height anomaly or column mass anomaly, in m or kg m-2. + real, dimension(SZIB_(G),SZJ_(G)), & + intent(out) :: uhbtav !< The barotropic zonal volume or mass + !! fluxes averaged through the barotropic steps, in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G)), & + intent(out) :: vhbtav !< The barotropic meridional volume or + !! mass fluxes averaged through the barotropic steps, in m3 s-1 or kg s-1. + type(legacy_barotropic_CS), pointer :: CS !< The control structure returned by a + !! previous call to barotropic_init. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in), optional :: visc_rem_u !< Both the fraction of the momentum + !! originally in a layer that remains after a time-step of viscosity, and the fraction + !! of a time-step's worth of a barotropic acceleration that a layer experiences after + !! viscosity is applied, in the zonal (_u) and meridional (_v) directions. + !! Nondimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in), optional :: visc_rem_v !< Both the fraction of the momentum + !! originally in a layer that remains after a time-step of viscosity, and the fraction + !! of a time-step's worth of a barotropic acceleration that a layer experiences after + !! viscosity is applied, in the zonal (_u) and meridional (_v) directions. + !! Nondimensional between 0 (at the bottom) and 1 (far above the bottom). + real, dimension(SZI_(G),SZJ_(G)), & + intent(out), optional :: etaav !< The free surface height or column mass + !! averaged over the barotropic integration, in m or kg m-2. + real, dimension(SZIB_(G),SZJ_(G)), & + intent(out), optional :: uhbt_out !< The barotropic zonal volume or mass + !! fluxes averaged through the barotropic steps, in m3 s-1 or kg s-1. + real, dimension(SZI_(G),SZJB_(G)), & + intent(out), optional :: vhbt_out !< The barotropic meridional volume or + !! mass fluxes averaged through the barotropic steps, in m3 s-1 or kg s-1. + type(ocean_OBC_type), & + pointer, optional :: OBC !< An open boundary condition type, which + !! contains the values associated with open boundary conditions. + type(BT_cont_type), & + pointer, optional :: BT_cont !< A structure with elements that describe + !! the effective open face areas as a function of barotropic flow. + real, dimension(:,:), & + pointer, optional :: eta_PF_start !< The eta field consistent with the + !! pressure gradient at the start of the barotropic stepping, in m or kg m-2. + real, dimension(:,:), & + pointer, optional :: taux_bot !< The zonal bottom frictional stress + !! from ocean to the seafloor, in Pa. + real, dimension(:,:), & + pointer, optional :: tauy_bot !< The meridional bottom frictional stress + !! from ocean to the seafloor, in Pa. + real, dimension(:,:,:), & + pointer, optional :: uh0, u_uh0 + real, dimension(:,:,:), & + pointer, optional :: vh0, v_vh0 ! Arguments: use_fluxes - A logical indicating whether velocities (false) or ! fluxes (true) are used to initialize the barotropic @@ -2037,14 +2101,24 @@ subroutine legacy_btstep(use_fluxes, U_in, V_in, eta_in, dt, bc_accel_u, bc_acce end subroutine legacy_btstep subroutine legacy_set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(legacy_barotropic_CS), pointer :: CS - real, dimension(SZI_(G),SZJ_(G)), intent(in), optional :: eta - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in), optional :: pbce - type(BT_cont_type), pointer, optional :: BT_cont - real, intent(in), optional :: gtot_est - real, intent(in), optional :: SSH_add + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + type(legacy_barotropic_CS), pointer :: CS !< The control structure returned + !! by a previous call to barotropic_init. + real, dimension(SZI_(G),SZJ_(G)), & + intent(in), optional :: eta !< The barotropic free surface + !! height anomaly or column mass anomaly, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in), optional :: pbce !< The baroclinic pressure anomaly + !! in each layer due to free surface height anomalies, in m2 H-1 s-2. + type(BT_cont_type), pointer, optional :: BT_cont !< A structure with elements that + !! describe the effective open face areas as a function of barotropic flow. + real, intent(in), optional :: gtot_est !< An estimate of the total + !! gravitational acceleration, in m s-2. + real, intent(in), optional :: SSH_add !< An additional contribution to + !! SSH to provide a margin of error when calculating the external wave speed, in m + ! Arguments: G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. ! (in) CS - The control structure returned by a previous call to @@ -2154,28 +2228,57 @@ subroutine legacy_set_dtbt(G, GV, CS, eta, pbce, BT_cont, gtot_est, SSH_add) end subroutine legacy_set_dtbt ! The following 4 subroutines apply the open boundary conditions. +!> This subroutine applies the open boundary conditions on barotropic +!! velocities and mass transports, as developed by Mehmet Ilicak. subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, & eta, ubt_old, vbt_old, BT_OBC, & G, MS, halo, dtbt, bebt, use_BT_cont, Datu, Datv, & BTCL_u, BTCL_v, uhbt0, vhbt0) - type(ocean_OBC_type), pointer :: OBC - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(memory_size_type), intent(in) :: MS - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt, uhbt, ubt_trans - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt, vhbt, vbt_trans - real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old - type(BT_OBC_type), intent(in) :: BT_OBC - integer, intent(in) :: halo - real, intent(in) :: dtbt, bebt - logical, intent(in) :: use_BT_cont - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv - type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u - type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 + type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an + !! OBC type. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(memory_size_type), intent(in) :: MS !< A type that describes the + !! memory sizes of the argument arrays. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt !< The zonal barotropic velocity, + !! in m s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: uhbt !< The zonal barotropic transport, + !! in H m2 s-1. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(inout) :: ubt_trans !< The zonal barotropic velocity + !! used in transport, m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt !< The meridional barotropic + !! velocity, in m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vhbt !< The meridional barotropic + !! transport, in H m2 s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(inout) :: vbt_trans !< The meridional BT velocity + !! used in transports, m s-1. + real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface + !! height anomaly or column mass anomaly, in m or kg m-2. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt_old !< The starting value of ubt in a + !! barotropic step, m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt_old !< The starting value of ubt in a + !! barotropic step, m s-1. + type(BT_OBC_type), intent(in) :: BT_OBC !< A structure with the private + !! barotropic arrays related to the open + !! boundary conditions, set by set_up_BT_OBC. + integer, intent(in) :: halo !< The extra halo size to + !! use here. + real, intent(in) :: dtbt !< The time step, in s. + real, intent(in) :: bebt !< The fractional weighting of + !! the future velocity in determining the transport. + logical, intent(in) :: use_BT_cont !< If true, use the + !! BT_cont_types to calculate transports. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face + !! areas at u points. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face + !! areas at u points. + type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & + intent(in) :: BTCL_u !< Structures of information used + !! for a dynamic estimate of the face areas at u- points. + type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & + intent(in) :: BTCL_v !< Structures of information used + !! for a dynamic estimate of the face areas at v- points. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: uhbt0 + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vhbt0 ! This subroutine applies the open boundary conditions on barotropic ! velocities and mass transports, as developed by Mehmet Ilicak. @@ -2345,16 +2448,25 @@ subroutine apply_velocity_OBCs(OBC, ubt, vbt, uhbt, vhbt, ubt_trans, vbt_trans, end subroutine apply_velocity_OBCs +!> This subroutine applies the open boundary conditions on the free surface +!! height, as coded by Mehmet Ilicak. subroutine apply_eta_OBCs(OBC, eta, ubt, vbt, BT_OBC, G, MS, halo, dtbt) - type(ocean_OBC_type), pointer :: OBC - type(memory_size_type), intent(in) :: MS - real, dimension(SZIW_(MS),SZJW_(MS)), intent(inout) :: eta - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt - type(BT_OBC_type), intent(in) :: BT_OBC - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - integer, intent(in) :: halo - real, intent(in) :: dtbt + type(ocean_OBC_type), pointer :: OBC !< An associated pointer to + !! an OBC type. + type(memory_size_type), intent(in) :: MS !< A type that describes the memory + !! sizes of the argument arrays. + real, dimension(SZIW_(MS),SZJW_(MS)), intent(inout) :: eta !< The barotropic free surface height + !! anomaly or column mass anomaly, in m or kg m-2. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: ubt !< The zonal barotropic velocity, + !! in m s-1. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: vbt !< The meridional barotropic + !! velocity, in m s-1. + type(BT_OBC_type), intent(in) :: BT_OBC ! This subroutine sets up the private structure used to apply the open +!! boundary conditions, as developed by Mehmet Ilicak. subroutine set_up_BT_OBC(OBC, eta, BT_OBC, G, GV, MS, halo, use_BT_cont, Datu, Datv, BTCL_u, BTCL_v) - type(ocean_OBC_type), pointer :: OBC - type(memory_size_type), intent(in) :: MS - real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta - type(BT_OBC_type), intent(inout) :: BT_OBC - 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) :: halo - logical, intent(in) :: use_BT_cont - real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu - real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv - type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: BTCL_u - type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: BTCL_v + type(ocean_OBC_type), pointer :: OBC !< An associated pointer to an + !! OBC type. + type(memory_size_type), intent(in) :: MS !< A type that describes the memory + !! sizes of the argument arrays. + real, dimension(SZIW_(MS),SZJW_(MS)), intent(in) :: eta !< The barotropic free surface + !! height anomaly or column mass anomaly, in m or kg m-2. + type(BT_OBC_type), intent(inout) :: BT_OBC !< A structure with the private + !! barotropic arrays related to the open + !! boundary conditions, set by set_up_BT_OBC. + 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) :: halo !< The extra halo size to use here. + logical, intent(in) :: use_BT_cont !< If true, use the + !! BT_cont_types to calculate transports. + real, dimension(SZIBW_(MS),SZJW_(MS)), intent(in) :: Datu !< A fixed estimate of the face + !! areas at u points. + real, dimension(SZIW_(MS),SZJBW_(MS)), intent(in) :: Datv !< A fixed estimate of the face + !! areas at v points. + type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & + intent(in) :: BTCL_u !< Structures of information used + !! for a dynamic estimate of the face areas at u- points. + type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & + intent(in) :: BTCL_v !< Structures of information used + !! for a dynamic estimate of the face areas at v- points. ! This subroutine sets up the private structure used to apply the open ! boundary conditions, as developed by Mehmet Ilicak. @@ -2592,15 +2718,26 @@ subroutine destroy_BT_OBC(BT_OBC) deallocate(BT_OBC%eta_outer_v) end subroutine destroy_BT_OBC - +!> This subroutine calculates the barotropic velocities from the full velocity and +!! thickness fields, determines the fraction of the total water column in each +!! layer at velocity points, and determines a corrective fictitious mass source +!! that will drive the barotropic estimate of the free surface height toward the +!! baroclinic estimate. subroutine legacy_btcalc(h, G, GV, CS, h_u, h_v, may_use_default) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(legacy_barotropic_CS), pointer :: CS - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in), optional :: h_u - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in), optional :: h_v - logical, intent(in), optional :: may_use_default + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(legacy_barotropic_CS), pointer :: CS !< The control structure returned + !! by a previous call to barotropic_init. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in), optional :: h_u !< The specified thicknesses at u- + !! and v- points, in m or kg m-2. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in), optional :: h_v !< The specified thicknesses at u- + !! and v- points, in m or kg m-2. + logical, intent(in), optional :: may_use_default ! btcalc calculates the barotropic velocities from the full velocity and ! thickness fields, determines the fraction of the total water column in each ! layer at velocity points, and determines a corrective fictitious mass source @@ -2858,10 +2995,14 @@ function find_uhbt(u, BTC) result(uhbt) end function find_uhbt function uhbt_to_ubt(uhbt, BTC, guess) result(ubt) - real, intent(in) :: uhbt - type(local_BT_cont_u_type), intent(in) :: BTC - real, optional, intent(in) :: guess - real :: ubt ! The result + real, intent(in) :: uhbt !< The barotropic zonal transport that should be + !! inverted for, in units of H m2 s-1. + type(local_BT_cont_u_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated + !! consistently with the layers' continuity equations. + real, optional, intent(in) :: guess !< A guess at what ubt will be. The result is not + !! allowed to be dramatically larger than guess. + real :: ubt !< The result ! This function inverts the transport function to determine the barotopic ! velocity that is consistent with a given transport. ! Arguments: uhbt - The barotropic zonal transport that should be inverted @@ -2975,10 +3116,14 @@ function find_vhbt(v, BTC) result(vhbt) end function find_vhbt function vhbt_to_vbt(vhbt, BTC, guess) result(vbt) - real, intent(in) :: vhbt - type(local_BT_cont_v_type), intent(in) :: BTC - real, optional, intent(in) :: guess - real :: vbt ! The result + real, intent(in) :: vhbt + type(local_BT_cont_v_type), intent(in) :: BTC !< A structure containing various fields that + !! allow the barotropic transports to be calculated + !! consistently with the layers' continuity equations. + real, optional, intent(in) :: guess !< A guess at what vbt will be. The result is not + !! allowed to be dramatically larger than guess. + real :: vbt !< The result: The velocity that gives vhbt + !! transport, in m s-1. ! This function inverts the transport function to determine the barotopic ! velocity that is consistent with a given transport. ! Arguments: vhbt_in - The barotropic meridional transport that should be @@ -3074,13 +3219,21 @@ end function vhbt_to_vbt subroutine set_local_BT_cont_types(BT_cont, BTCL_u, BTCL_v, G, MS, BT_Domain, halo) - type(BT_cont_type), intent(inout) :: BT_cont - type(memory_size_type), intent(in) :: MS - type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), intent(out) :: BTCL_u - type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), intent(out) :: BTCL_v - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(MOM_domain_type), intent(inout) :: BT_Domain - integer, optional, intent(in) :: halo + type(BT_cont_type), intent(inout) :: BT_cont !< The BT_cont_type input to the + !! barotropic solver. + type(memory_size_type), intent(in) :: MS !< A type that describes the + !! memory sizes of the argument arrays. + type(local_BT_cont_u_type), dimension(SZIBW_(MS),SZJW_(MS)), & + intent(out) :: BTCL_u !< A structure with the u + !! information from BT_cont. + type(local_BT_cont_v_type), dimension(SZIW_(MS),SZJBW_(MS)), & + intent(out) :: BTCL_v !< A structure with the v + !! information from BT_cont. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(MOM_domain_type), intent(inout) :: BT_Domain !< The domain to use for + !! updating the halos of wide arrays. + integer, optional, intent(in) :: halo !< The extra halo size + !! to use here. ! This subroutine sets up reordered versions of the BT_cont type in the ! local_BT_cont types, which have wide halos properly filled in. ! Arguments: BT_cont - The BT_cont_type input to the barotropic solver. @@ -3183,12 +3336,19 @@ end subroutine set_local_BT_cont_types subroutine BT_cont_to_face_areas(BT_cont, Datu, Datv, G, MS, halo, maximize) type(BT_cont_type), intent(inout) :: BT_cont - type(memory_size_type), intent(in) :: MS - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - integer, optional, intent(in) :: halo - logical, optional, intent(in) :: maximize + type(memory_size_type), intent(in) :: MS !< A type that describes the + !! memory sizes of the argument + !! arrays. + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The open zonal face area, in + !! H m (m2 or kg m-1). + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The open meridional face + !! area, in H m (m2 or kg m-1). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, optional, intent(in) :: halo !< The halo size to use, + !! default = 1. + logical, optional, intent(in) :: maximize ! This subroutine uses the BTCL types to find typical or maximum face ! areas, which can then be used for finding wave speeds, etc. logical :: find_max @@ -3223,16 +3383,26 @@ subroutine swap(a,b) end subroutine swap subroutine find_face_areas(Datu, Datv, G, GV, CS, MS, rescale_faces, eta, halo, add_max) - type(memory_size_type), intent(in) :: MS - real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), intent(out) :: Datu - real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), intent(out) :: Datv - 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(legacy_barotropic_CS), pointer :: CS - logical, optional, intent(in) :: rescale_faces - real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), optional, intent(in) :: eta - integer, optional, intent(in) :: halo - real, optional, intent(in) :: add_max + type(memory_size_type), intent(in) :: MS !< A type that describes the memory sizes + !! of the argument arrays. + real, dimension(MS%isdw-1:MS%iedw,MS%jsdw:MS%jedw), & + intent(out) :: Datu !< The open zonal face area, in H m + !! (m2 or kg m-1). + real, dimension(MS%isdw:MS%iedw,MS%jsdw-1:MS%jedw), & + intent(out) :: Datv !< The open meridional face area, in H m + !! (m2 or kg m-1). + 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(legacy_barotropic_CS), pointer :: CS !< The control structure returned by a + !! previous call to barotropic_init. + logical, optional, intent(in) :: rescale_faces !< If true, rescale the face areas + !! by Datu_res, etc. + real, dimension(MS%isdw:MS%iedw,MS%jsdw:MS%jedw), & + optional, intent(in) :: eta !< The barotropic free surface height + !! anomaly or column mass anomaly, in m or kg m-2. + integer, optional, intent(in) :: halo !< The halo size to use, default = 1. + real, optional, intent(in) :: add_max !< A value to add to the maximum depth + !! (used to overestimate the external wave speed) in m. ! Arguments: Datu - The open zonal face area, in H m (m2 or kg m-1). ! (out) Datv - The open meridional face area, in H m (m2 or kg m-1). ! (in) G - The ocean's grid structure. @@ -3334,14 +3504,26 @@ end subroutine find_face_areas subroutine legacy_bt_mass_source(h, eta, fluxes, set_cor, dt_therm, & dt_since_therm, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta - type(forcing), intent(in) :: fluxes - logical, intent(in) :: set_cor - real, intent(in) :: dt_therm, dt_since_therm - type(legacy_barotropic_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G)), & + intent(in) :: eta !< The free surface height that is to be + !! corrected, in m. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + logical, intent(in) :: set_cor !< A flag to indicate whether to set the + !! corrective fluxes (and update the slowly varying part of eta_cor) + !! (.true.) or whether to incrementally update the corrective fluxes. + real, intent(in) :: dt_therm !< The thermodynamic time step, in s. + real, intent(in) :: dt_since_therm !< The elapsed time since mass forcing + !! was applied, s. + type(legacy_barotropic_CS), pointer :: CS !< The control structure returned by a + !! previous call to barotropic_init. + ! bt_mass_source determines the appropriately limited mass source for ! the barotropic solver, along with a corrective fictitious mass source that ! will drive the barotropic estimate of the free surface height toward the @@ -3440,19 +3622,31 @@ end subroutine legacy_bt_mass_source subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, CS, & restart_CS, BT_cont, tides_CSp) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, intent(in), dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity, in m s-1 - real, intent(in), dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity, in m s-1 - real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, intent(in), dimension(SZI_(G),SZJ_(G)) :: eta - type(time_type), target, intent(in) :: Time - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(legacy_barotropic_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS - type(BT_cont_type), optional, pointer :: BT_cont - type(tidal_forcing_CS), optional, pointer :: tides_CSp + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, intent(in), dimension(SZIB_(G),SZJ_(G),SZK_(G)) :: u !< The zonal velocity, in m s-1. + real, intent(in), dimension(SZI_(G),SZJB_(G),SZK_(G)) :: v !< The meridional velocity, + !! in m s-1. + real, intent(in), dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, intent(in), dimension(SZI_(G),SZJ_(G)) :: eta !< Free surface height or column + !! mass anomaly, in m or kg m-2. + type(time_type), target, intent(in) :: Time !< The current model time. + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(legacy_barotropic_CS), pointer :: CS !< A pointer to the control + !! structure for this module that is + !! set in register_barotropic_restarts. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart + !! control structure. + type(BT_cont_type), optional, pointer :: BT_cont !< A structure with elements that + !! describe the effective open face areas + !! as a function of barotropic flow. + type(tidal_forcing_CS), optional, pointer :: tides_CSp !< A pointer to the control + !! structure of the tide module. ! barotropic_init initializes a number of time-invariant fields used in the ! barotropic calculation and initializes any barotropic fields that have not ! already been initialized. @@ -3475,7 +3669,7 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C ! (in) tides_CSp - a pointer to the control structure of the tide module. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_barotropic" ! This module's name. + character(len=40) :: mdl = "MOM_barotropic" ! This module's name. real :: Datu(SZIBS_(G),SZJ_(G)), Datv(SZI_(G),SZJBS_(G)) real :: gtot_estimate ! Summing GV%g_prime gives an upper-bound estimate for pbce. real :: SSH_extra ! An estimate of how much higher SSH might get, for use @@ -3509,28 +3703,28 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "SPLIT", CS%split, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SPLIT", CS%split, & "Use the split time stepping if true.", default=.true.) if (.not.CS%split) return ! ### USE SOMETHING OTHER THAN MAXVEL FOR THIS... - call get_param(param_file, mod, "BOUND_BT_CORRECTION", CS%bound_BT_corr, & + call get_param(param_file, mdl, "BOUND_BT_CORRECTION", CS%bound_BT_corr, & "If true, the corrective pseudo mass-fluxes into the \n"//& "barotropic solver are limited to values that require \n"//& "less than 0.1*MAXVEL to be accommodated.",default=.false.) - call get_param(param_file, mod, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & + call get_param(param_file, mdl, "GRADUAL_BT_ICS", CS%gradual_BT_ICs, & "If true, adjust the initial conditions for the \n"//& "barotropic solver to the values from the layered \n"//& "solution over a whole timestep instead of instantly. \n"//& "This is a decent approximation to the inclusion of \n"//& "sum(u dh_dt) while also correcting for truncation errors.", & default=.false.) - call get_param(param_file, mod, "BT_USE_WIDE_HALOS", CS%use_wide_halos, & + call get_param(param_file, mdl, "BT_USE_WIDE_HALOS", CS%use_wide_halos, & "If true, use wide halos and march in during the \n"//& "barotropic time stepping for efficiency.", default=.true., & layoutParam=.true.) - call get_param(param_file, mod, "BTHALO", bt_halo_sz, & + call get_param(param_file, mdl, "BTHALO", bt_halo_sz, & "The minimum halo size for the barotropic solver.", default=0, & layoutParam=.true.) #ifdef STATIC_MEMORY_ @@ -3541,44 +3735,44 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C #else wd_halos(1) = bt_halo_sz; wd_halos(2) = bt_halo_sz #endif - call log_param(param_file, mod, "!BT x-halo", wd_halos(1), & + call log_param(param_file, mdl, "!BT x-halo", wd_halos(1), & "The barotropic x-halo size that is actually used.", & layoutParam=.true.) - call log_param(param_file, mod, "!BT y-halo", wd_halos(2), & + call log_param(param_file, mdl, "!BT y-halo", wd_halos(2), & "The barotropic y-halo size that is actually used.", & layoutParam=.true.) - call get_param(param_file, mod, "USE_BT_CONT_TYPE", use_BT_cont_type, & + call get_param(param_file, mdl, "USE_BT_CONT_TYPE", use_BT_cont_type, & "If true, use a structure with elements that describe \n"//& "effective face areas from the summed continuity solver \n"//& "as a function the barotropic flow in coupling between \n"//& "the barotropic and baroclinic flow. This is only used \n"//& "if SPLIT is true. \n", default=.true.) - call get_param(param_file, mod, "NONLINEAR_BT_CONTINUITY", & + call get_param(param_file, mdl, "NONLINEAR_BT_CONTINUITY", & CS%Nonlinear_continuity, & "If true, use nonlinear transports in the barotropic \n"//& "continuity equation. This does not apply if \n"//& "USE_BT_CONT_TYPE is true.", default=.false.) CS%Nonlin_cont_update_period = 1 if (CS%Nonlinear_continuity) & - call get_param(param_file, mod, "NONLIN_BT_CONT_UPDATE_PERIOD", & + call get_param(param_file, mdl, "NONLIN_BT_CONT_UPDATE_PERIOD", & CS%Nonlin_cont_update_period, & "If NONLINEAR_BT_CONTINUITY is true, this is the number \n"//& "of barotropic time steps between updates to the face \n"//& "areas, or 0 to update only before the barotropic stepping.",& units="nondim", default=1) - call get_param(param_file, mod, "RESCALE_BT_FACE_AREAS", CS%rescale_D_bt, & + call get_param(param_file, mdl, "RESCALE_BT_FACE_AREAS", CS%rescale_D_bt, & "If true, the face areas used by the barotropic solver \n"//& "are rescaled to approximately reflect the open face \n"//& "areas of the interior layers. This probably requires \n"//& "FLUX_BT_COUPLING to work, and should not be used with \n"//& "USE_BT_CONT_TYPE.", default=.false.) - call get_param(param_file, mod, "BT_MASS_SOURCE_LIMIT", CS%eta_source_limit, & + call get_param(param_file, mdl, "BT_MASS_SOURCE_LIMIT", CS%eta_source_limit, & "The fraction of the initial depth of the ocean that can \n"//& "be added to or removed from the bartropic solution \n"//& "within a thermodynamic time step. By default this is 0 \n"//& "for no correction.", units="nondim", default=0.0) - call get_param(param_file, mod, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& + call get_param(param_file, mdl, "BT_PROJECT_VELOCITY", CS%BT_project_velocity,& "If true, step the barotropic velocity first and project \n"//& "out the velocity tendancy by 1+BEBT when calculating the \n"//& "transport. The default (false) is to use a predictor \n"//& @@ -3587,36 +3781,36 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C "average of the old and new velocities, with weights \n"//& "of (1-BEBT) and BEBT.", default=.false.) - call get_param(param_file, mod, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & + call get_param(param_file, mdl, "DYNAMIC_SURFACE_PRESSURE", CS%dynamic_psurf, & "If true, add a dynamic pressure due to a viscous ice \n"//& "shelf, for instance.", default=.false.) if (CS%dynamic_psurf) then - call get_param(param_file, mod, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, & + call get_param(param_file, mdl, "ICE_LENGTH_DYN_PSURF", CS%ice_strength_length, & "The length scale at which the Rayleigh damping rate due \n"//& "to the ice strength should be the same as if a Laplacian \n"//& "were applied, if DYNAMIC_SURFACE_PRESSURE is true.", & units="m", default=1.0e4) - call get_param(param_file, mod, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & + call get_param(param_file, mdl, "DEPTH_MIN_DYN_PSURF", CS%Dmin_dyn_psurf, & "The minimum depth to use in limiting the size of the \n"//& "dynamic surface pressure for stability, if \n"//& "DYNAMIC_SURFACE_PRESSURE is true..", units="m", & default=1.0e-6) - call get_param(param_file, mod, "CONST_DYN_PSURF", CS%const_dyn_psurf, & + call get_param(param_file, mdl, "CONST_DYN_PSURF", CS%const_dyn_psurf, & "The constant that scales the dynamic surface pressure, \n"//& "if DYNAMIC_SURFACE_PRESSURE is true. Stable values \n"//& "are < ~1.0.", units="nondim", default=0.9) endif - call get_param(param_file, mod, "TIDES", CS%tides, & + call get_param(param_file, mdl, "TIDES", CS%tides, & "If true, apply tidal momentum forcing.", default=.false.) - call get_param(param_file, mod, "SADOURNY", CS%Sadourny, & + call get_param(param_file, mdl, "SADOURNY", CS%Sadourny, & "If true, the Coriolis terms are discretized with the \n"//& "Sadourny (1975) energy conserving scheme, otherwise \n"//& "the Arakawa & Hsu scheme is used. If the internal \n"//& "deformation radius is not resolved, the Sadourny scheme \n"//& "should probably be used.", default=.true.) - call get_param(param_file, mod, "BT_THICK_SCHEME", hvel_str, & + call get_param(param_file, mdl, "BT_THICK_SCHEME", hvel_str, & "A string describing the scheme that is used to set the \n"//& "open face areas used for barotropic transport and the \n"//& "relative weights of the accelerations. Valid values are:\n"//& @@ -3643,54 +3837,54 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C call MOM_error(FATAL, "barotropic_init: BT_THICK_SCHEME FROM_BT_CONT "//& "can only be used if USE_BT_CONT_TYPE is defined.") - call get_param(param_file, mod, "APPLY_BT_DRAG", apply_bt_drag, & + call get_param(param_file, mdl, "APPLY_BT_DRAG", apply_bt_drag, & "If defined, bottom drag is applied within the \n"//& "barotropic solver.", default=.true.) - call get_param(param_file, mod, "BT_STRONG_DRAG", CS%strong_drag, & + call get_param(param_file, mdl, "BT_STRONG_DRAG", CS%strong_drag, & "If true, use a stronger estimate of the retarding \n"//& "effects of strong bottom drag, by making it implicit \n"//& "with the barotropic time-step instead of implicit with \n"//& "the baroclinic time-step and dividing by the number of \n"//& "barotropic steps.", default=.true.) - call get_param(param_file, mod, "CLIP_BT_VELOCITY", CS%clip_velocity, & + call get_param(param_file, mdl, "CLIP_BT_VELOCITY", CS%clip_velocity, & "If true, limit any velocity components that exceed \n"//& "MAXVEL. This should only be used as a desperate \n"//& "debugging measure.", default=.false.) - call get_param(param_file, mod, "MAXVEL", CS%maxvel, & + call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8, & do_not_log=.not.CS%clip_velocity) - call get_param(param_file, mod, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & + call get_param(param_file, mdl, "MAXCFL_BT_CONT", CS%maxCFL_BT_cont, & "The maximum permitted CFL number associated with the \n"//& "barotropic accelerations from the summed velocities \n"//& "times the time-derivatives of thicknesses.", units="nondim", & default=0.1) - call get_param(param_file, mod, "DT_BT_FILTER", CS%dt_bt_filter, & + call get_param(param_file, mdl, "DT_BT_FILTER", CS%dt_bt_filter, & "A time-scale over which the barotropic mode solutions \n"//& "are filtered, in seconds if positive, or as a fraction \n"//& "of DT if negative. When used this can never be taken to \n"//& "be longer than 2*dt. Set this to 0 to apply no filtering.", & units="sec or nondim", default=-0.25) - call get_param(param_file, mod, "G_BT_EXTRA", CS%G_extra, & + call get_param(param_file, mdl, "G_BT_EXTRA", CS%G_extra, & "A nondimensional factor by which gtot is enhanced.", & units="nondim", default=0.0) - call get_param(param_file, mod, "SSH_EXTRA", SSH_extra, & + call get_param(param_file, mdl, "SSH_EXTRA", SSH_extra, & "An estimate of how much higher SSH might get, for use \n"//& "in calculating the safe external wave speed. The \n"//& "default is the minimum of 10 m or 5% of MAXIMUM_DEPTH.", & units="m", default=min(10.0,0.05*G%max_depth)) - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "DEBUG_BT", CS%debug_bt, & + call get_param(param_file, mdl, "DEBUG_BT", CS%debug_bt, & "If true, write out verbose debugging data within the \n"//& "barotropic time-stepping loop. The data volume can be \n"//& "quite large if this is true.", default=CS%debug) CS%linearized_BT_PV = .true. - call get_param(param_file, mod, "BEBT", CS%bebt, & + call get_param(param_file, mdl, "BEBT", CS%bebt, & "BEBT determines whether the barotropic time stepping \n"//& "uses the forward-backward time-stepping scheme or a \n"//& "backward Euler scheme. BEBT is valid in the range from \n"//& @@ -3698,7 +3892,7 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C "gravity waves) to 1 (for a backward Euler treatment). \n"//& "In practice, BEBT must be greater than about 0.05.", & units="nondim", default=0.1) - call get_param(param_file, mod, "DTBT", CS%dtbt, & + call get_param(param_file, mdl, "DTBT", CS%dtbt, & "The barotropic time step, in s. DTBT is only used with \n"//& "the split explicit time stepping. To set the time step \n"//& "automatically based the maximum stable value use 0, or \n"//& @@ -3830,8 +4024,8 @@ subroutine legacy_barotropic_init(u, v, h, eta, Time, G, GV, param_file, diag, C call legacy_set_dtbt(G, GV, CS, gtot_est = gtot_estimate, SSH_add = SSH_extra) if (dtbt_input > 0.0) CS%dtbt = dtbt_input - call log_param(param_file, mod, "!DTBT as used", CS%dtbt) - call log_param(param_file, mod, "!estimated maximum DTBT", CS%dtbt_max) + call log_param(param_file, mdl, "!DTBT as used", CS%dtbt) + call log_param(param_file, mdl, "!estimated maximum DTBT", CS%dtbt_max) ! ubtav, vbtav, ubt_IC, vbt_IC, uhbt_IC, and vhbt_IC are allocated and ! initialized in register_barotropic_restarts. @@ -4006,12 +4200,15 @@ subroutine legacy_barotropic_end(CS) deallocate(CS) end subroutine legacy_barotropic_end +!> This subroutine is used to register any fields from MOM_barotropic.F90 +!! that should be written to or read from the restart file. subroutine register_legacy_barotropic_restarts(HI, GV, param_file, CS, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(legacy_barotropic_CS), pointer :: CS - type(MOM_restart_CS), pointer :: restart_CS + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. + type(legacy_barotropic_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! This subroutine is used to register any fields from MOM_barotropic.F90 ! that should be written to or read from the restart file. ! Arguments: HI - A horizontal index type structure. diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index f3ec01aadf..1271cd0fdc 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -199,7 +199,7 @@ module MOM_open_boundary integer :: id_clock_pass -character(len=40) :: mod = "MOM_open_boundary" ! This module's name. +character(len=40) :: mdl = "MOM_open_boundary" ! This module's name. ! This include declares and sets the variable "version". #include "version_variable.h" @@ -224,51 +224,51 @@ subroutine open_boundary_config(G, param_file, OBC) allocate(OBC) - call log_version(param_file, mod, version, "Controls where open boundaries are located, what "//& + call log_version(param_file, mdl, version, "Controls where open boundaries are located, what "//& "kind of boundary condition to impose, and what data to apply, if any.") - call get_param(param_file, mod, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & + call get_param(param_file, mdl, "OBC_NUMBER_OF_SEGMENTS", OBC%number_of_segments, & "The number of open boundary segments.", & default=0) - call get_param(param_file, mod, "G_EARTH", OBC%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", OBC%g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "OBC_USER_CONFIG", config1, & + call get_param(param_file, mdl, "OBC_USER_CONFIG", config1, & "A string that sets how the open boundary conditions are \n"//& " configured: \n", default="none", do_not_log=.true.) - call get_param(param_file, mod, "NK", OBC%ke, & + call get_param(param_file, mdl, "NK", OBC%ke, & "The number of model layers", default=0, do_not_log=.true.) if (config1 .ne. "none") OBC%user_BCs_set_globally = .true. ! It's in state initialization... ! if (config1 .eq. "tidal_bay") OBC%update_OBC = .true. - call get_param(param_file, mod, "EXTEND_OBC_SEGMENTS", OBC%extend_segments, & + call get_param(param_file, mdl, "EXTEND_OBC_SEGMENTS", OBC%extend_segments, & "If true, extend OBC segments. This option is used to recover\n"//& "legacy solutions dependent on an incomplete implementaion of OBCs.\n"//& "This option will be obsoleted in the future.", default=.false.) if (OBC%number_of_segments > 0) then - call get_param(param_file, mod, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & + call get_param(param_file, mdl, "OBC_ZERO_VORTICITY", OBC%zero_vorticity, & "If true, sets relative vorticity to zero on open boundaries.", & default=.false.) - call get_param(param_file, mod, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & + call get_param(param_file, mdl, "OBC_FREESLIP_VORTICITY", OBC%freeslip_vorticity, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the relative vorticity on open boundaries. This cannot\n"// & "be true if OBC_ZERO_VORTICITY is True.", default=.false.) if (OBC%zero_vorticity .and. OBC%freeslip_vorticity) call MOM_error(FATAL, & "MOM_open_boundary.F90, open_boundary_config: "//& "Only one of OBC_ZERO_VORTICITY and OBC_FREESLIP_VORTICITY can be True at once.") - call get_param(param_file, mod, "OBC_ZERO_STRAIN", OBC%zero_strain, & + call get_param(param_file, mdl, "OBC_ZERO_STRAIN", OBC%zero_strain, & "If true, sets the strain used in the stress tensor to zero on open boundaries.", & default=.false.) - call get_param(param_file, mod, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & + call get_param(param_file, mdl, "OBC_FREESLIP_STRAIN", OBC%freeslip_strain, & "If true, sets the normal gradient of tangential velocity to\n"// & "zero in the strain use in the stress tensor on open boundaries. This cannot\n"// & "be true if OBC_ZERO_STRAIN is True.", default=.false.) if (OBC%zero_strain .and. OBC%freeslip_strain) call MOM_error(FATAL, & "MOM_open_boundary.F90, open_boundary_config: "//& "Only one of OBC_ZERO_STRAIN and OBC_FREESLIP_STRAIN can be True at once.") - call get_param(param_file, mod, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & + call get_param(param_file, mdl, "OBC_ZERO_BIHARMONIC", OBC%zero_biharmonic, & "If true, zeros the Laplacian of flow on open boundaries in the biharmonic\n"//& "viscosity term.", default=.false.) ! Allocate everything @@ -295,7 +295,7 @@ subroutine open_boundary_config(G, param_file, OBC) do l = 1, OBC%number_of_segments write(segment_param_str(1:15),"('OBC_SEGMENT_',i3.3)") l - call get_param(param_file, mod, segment_param_str, segment_str, & + call get_param(param_file, mdl, segment_param_str, segment_str, & "Documentation needs to be dynamic?????", & fail_if_missing=.true.) segment_str = remove_spaces(segment_str) @@ -360,23 +360,23 @@ subroutine initialize_segment_data(G, OBC, PF) ! param file so that I can use it later in step_MOM in order to finish ! initializing segments on the first step. - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(PF, mod, "REMAPPING_SCHEME", remappingScheme, & + call get_param(PF, mdl, "REMAPPING_SCHEME", remappingScheme, & "This sets the reconstruction scheme used\n"//& "for vertical remapping for all variables.\n"//& "It can be one of the following schemes:\n"//& trim(remappingSchemesDoc), default=remappingDefaultScheme,do_not_log=.true.) - call get_param(PF, mod, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & + call get_param(PF, mdl, "FATAL_CHECK_RECONSTRUCTIONS", check_reconstruction, & "If true, cell-by-cell reconstructions are checked for\n"//& "consistency and if non-monotonicity or an inconsistency is\n"//& "detected then a FATAL error is issued.", default=.false.,do_not_log=.true.) - call get_param(PF, mod, "FATAL_CHECK_REMAPPING", check_remapping, & + call get_param(PF, mdl, "FATAL_CHECK_REMAPPING", check_remapping, & "If true, the results of remapping are checked for\n"//& "conservation and new extrema and if an inconsistency is\n"//& "detected then a FATAL error is issued.", default=.false.,do_not_log=.true.) - call get_param(PF, mod, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & + call get_param(PF, mdl, "REMAP_BOUND_INTERMEDIATE_VALUES", force_bounds_in_subcell, & "If true, the values on the intermediate grid used for remapping\n"//& "are forced to be bounded, which might not be the case due to\n"//& "round off.", default=.false.,do_not_log=.true.) @@ -402,7 +402,7 @@ subroutine initialize_segment_data(G, OBC, PF) write(segnam,"('OBC_SEGMENT_',i3.3,'_DATA')") n write(suffix,"('_segment_',i3.3)") n - call get_param(PF, mod, segnam, segstr) + call get_param(PF, mdl, segnam, segstr) call parse_segment_data_str(trim(segstr), fields=fields, num_fields=num_fields) if (num_fields == 0) then @@ -952,19 +952,19 @@ subroutine open_boundary_init(G, param_file, OBC) if (.not.associated(OBC)) return if ( OBC%Flather_u_BCs_exist_globally .or. OBC%Flather_v_BCs_exist_globally ) then - call get_param(param_file, mod, "OBC_RADIATION_MAX", OBC%rx_max, & + call get_param(param_file, mdl, "OBC_RADIATION_MAX", OBC%rx_max, & "The maximum magnitude of the baroclinic radiation \n"//& "velocity (or speed of characteristics). This is only \n"//& "used if one of the open boundary segments is using Orlanski.", & units="m s-1", default=10.0) - call get_param(param_file, mod, "OBC_RAD_VEL_WT", OBC%gamma_uv, & + call get_param(param_file, mdl, "OBC_RAD_VEL_WT", OBC%gamma_uv, & "The relative weighting for the baroclinic radiation \n"//& "velocities (or speed of characteristics) at the new \n"//& "time level (1) or the running mean (0) for velocities. \n"//& "Valid values range from 0 to 1. This is only used if \n"//& "one of the open boundary segments is using Orlanski.", & units="nondim", default=0.3) - call get_param(param_file, mod, "OBC_RAD_THICK_WT", OBC%gamma_h, & + call get_param(param_file, mdl, "OBC_RAD_THICK_WT", OBC%gamma_h, & "The relative weighting for the baroclinic radiation \n"//& "velocities (or speed of characteristics) at the new \n"//& "time level (1) or the running mean (0) for thicknesses. \n"//& @@ -1526,7 +1526,7 @@ subroutine set_tracer_data(OBC, tv, h, G, PF, tracer_Reg) integer :: isd_off, jsd_off integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment ! pointer to segment type list - character(len=40) :: mod = "set_tracer_data" ! This subroutine's name. + character(len=40) :: mdl = "set_tracer_data" ! This subroutine's name. character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path real :: temp_u(G%domain%niglobal+1,G%domain%njglobal) @@ -1672,7 +1672,7 @@ subroutine allocate_OBC_segment_data(OBC, segment) ! Local variables integer :: isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB - character(len=40) :: mod = "allocate_OBC_segment_data" ! This subroutine's name. + character(len=40) :: mdl = "allocate_OBC_segment_data" ! This subroutine's name. isd = segment%HI%isd ; ied = segment%HI%ied jsd = segment%HI%jsd ; jed = segment%HI%jed @@ -1816,7 +1816,7 @@ subroutine update_OBC_segment_data(G, GV, OBC, tv, h, Time) integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed integer :: IsdB, IedB, JsdB, JedB, n, m, nz - character(len=40) :: mod = "set_OBC_segment_data" ! This subroutine's name. + character(len=40) :: mdl = "set_OBC_segment_data" ! This subroutine's name. character(len=200) :: filename, OBC_file, inputdir ! Strings for file/path type(OBC_segment_type), pointer :: segment integer, dimension(4) :: siz,siz2 @@ -2035,14 +2035,14 @@ subroutine OBC_registry_init(param_file, Reg) integer, save :: init_calls = 0 #include "version_variable.h" - character(len=40) :: mod = "MOM_open_boundary" ! This module's name. + character(len=40) :: mdl = "MOM_open_boundary" ! This module's name. character(len=256) :: mesg ! Message for error messages. if (.not.associated(Reg)) then ; allocate(Reg) else ; return ; endif ! Read all relevant parameters and write them to the model log. -! call log_version(param_file, mod, version, "") +! call log_version(param_file, mdl,s version, "") init_calls = init_calls + 1 if (init_calls > 1) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 7f2c50af4c..e27717367f 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -182,11 +182,6 @@ module MOM_variables !> The vertvisc_type structure contains vertical viscosities, drag !! coefficients, and related fields. type, public :: vertvisc_type - logical :: calc_bbl !< If true, the BBL viscosity and thickness - !! need to be recalculated. - real :: bbl_calc_time_interval !< The amount of time over which the impending - !! calculation of the BBL properties will apply, - !! for use in diagnostics of the BBL properties. real :: Prandtl_turb !< The Prandtl number for the turbulent diffusion !! that is captured in Kd_turb. real, pointer, dimension(:,:) :: & diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index d2be2394d1..9db3d1ebc8 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -91,49 +91,49 @@ subroutine verticalGridInit( param_file, GV ) ! This include declares and sets the variable "version". #include "version_variable.h" integer :: nk - character(len=16) :: mod = 'MOM_verticalGrid' + character(len=16) :: mdl = 'MOM_verticalGrid' if (associated(GV)) call MOM_error(FATAL, & 'verticalGridInit: called with an associated GV pointer.') allocate(GV) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "Parameters providing information about the vertical grid.") - call get_param(param_file, mod, "G_EARTH", GV%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", GV%g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", GV%Rho0, & + call get_param(param_file, mdl, "RHO_0", GV%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "BOUSSINESQ", GV%Boussinesq, & + call get_param(param_file, mdl, "BOUSSINESQ", GV%Boussinesq, & "If true, make the Boussinesq approximation.", default=.true.) - call get_param(param_file, mod, "ANGSTROM", GV%Angstrom_z, & + call get_param(param_file, mdl, "ANGSTROM", GV%Angstrom_z, & "The minumum layer thickness, usually one-Angstrom.", & units="m", default=1.0e-10) if (.not.GV%Boussinesq) then - call get_param(param_file, mod, "H_TO_KG_M2", GV%H_to_kg_m2,& + call get_param(param_file, mdl, "H_TO_KG_M2", GV%H_to_kg_m2,& "A constant that translates thicknesses from the model's \n"//& "internal units of thickness to kg m-2.", units="kg m-2 H-1", & default=1.0) else - call get_param(param_file, mod, "H_TO_M", GV%H_to_m, & + call get_param(param_file, mdl, "H_TO_M", GV%H_to_m, & "A constant that translates the model's internal \n"//& "units of thickness into m.", units="m H-1", default=1.0) endif #ifdef STATIC_MEMORY_ ! Here NK_ is a macro, while nk is a variable. - call get_param(param_file, mod, "NK", nk, & + call get_param(param_file, mdl, "NK", nk, & "The number of model layers.", units="nondim", & static_value=NK_) if (nk /= NK_) call MOM_error(FATAL, "verticalGridInit: " // & "Mismatched number of layers NK_ between MOM_memory.h and param_file") #else - call get_param(param_file, mod, "NK", nk, & + call get_param(param_file, mdl, "NK", nk, & "The number of model layers.", units="nondim", fail_if_missing=.true.) #endif GV%ke = nk @@ -153,7 +153,7 @@ subroutine verticalGridInit( param_file, GV ) GV%H_to_Pa = GV%g_Earth * GV%H_to_kg_m2 ! Log derivative values. - call log_param(param_file, mod, "M to THICKNESS", GV%m_to_H) + call log_param(param_file, mdl, "M to THICKNESS", GV%m_to_H) ALLOC_( GV%sInterface(nk+1) ) ALLOC_( GV%sLayer(nk) ) @@ -201,11 +201,21 @@ end function get_flux_units !> Returns the model's tracer flux units. function get_tr_flux_units(GV, tr_units, tr_vol_conc_units, tr_mass_conc_units) - character(len=48) :: get_tr_flux_units - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - character(len=*), optional, intent(in) :: tr_units - character(len=*), optional, intent(in) :: tr_vol_conc_units - character(len=*), optional, intent(in) :: tr_mass_conc_units + character(len=48) :: get_tr_flux_units !< The model's flux units + !! for a tracer. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical + !! grid structure. + character(len=*), optional, intent(in) :: tr_units !< Units for a tracer, for example + !! Celsius or PSU. + character(len=*), optional, intent(in) :: tr_vol_conc_units !< The concentration units per unit + !! volume, forexample if the units are + !! umol m-3, tr_vol_conc_units would + !! be umol. + character(len=*), optional, intent(in) :: tr_mass_conc_units !< The concentration units per unit + !! mass of sea water, for example if + !! the units are mol kg-1, + !! tr_vol_conc_units would be mol. + ! This subroutine returns the appropriate units for thicknesses and fluxes, ! depending on whether the model is Boussinesq or not and the scaling for ! the vertical thickness. diff --git a/src/diagnostics/MOM_PointAccel.F90 b/src/diagnostics/MOM_PointAccel.F90 index 6c3edab2ce..7d7ede3012 100644 --- a/src/diagnostics/MOM_PointAccel.F90 +++ b/src/diagnostics/MOM_PointAccel.F90 @@ -92,20 +92,37 @@ module MOM_PointAccel contains +!> This subroutine writes to an output file all of the accelerations +!! that have been applied to a column of zonal velocities over the +!! previous timestep. This subroutine is called from vertvisc. subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & maxvel, minvel, str, a, hv) - integer, intent(in) :: I, j - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: um - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin - type(accel_diag_ptrs), intent(in) :: ADp - type(cont_diag_ptrs), intent(in) :: CDp - real, intent(in) :: dt !< The ocean dynamics time step, in s. - type(PointAccel_CS), pointer :: CS - real, intent(in) :: maxvel, minvel - real, optional, intent(in) :: str - real, dimension(SZIB_(G),SZK_(G)), optional, intent(in) :: a, hv + integer, intent(in) :: I !< The zonal index of the column to be documented. + integer, intent(in) :: j !< The meridional index of the column to be + !! documented. + 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(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: um !< The new zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< The layer thickness, in m. + type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various + !! accelerations in the momentum equations. + type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms + !! in the continuity equations. + real, intent(in) :: dt !< The ocean dynamics time step, in s. + type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous + !! call to PointAccel_init. + real, intent(in) :: maxvel, minvel + real, optional, intent(in) :: str !< The surface wind stress integrated over a time + !! step, in m2 s-1. + real, dimension(SZIB_(G),SZK_(G)), & + optional, intent(in) :: a !< The layer coupling coefficients from + !! vertvisc, m. + real, dimension(SZIB_(G),SZK_(G)), & + optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, + !! from vertvisc, in m. + ! This subroutine writes to an output file all of the accelerations ! that have been applied to a column of zonal velocities over the ! previous timestep. This subroutine is called from vertvisc. @@ -429,21 +446,36 @@ subroutine write_u_accel(I, j, um, hin, ADp, CDp, dt, G, GV, CS, & end subroutine write_u_accel - +!> This subroutine writes to an output file all of the accelerations +!! that have been applied to a column of meridional velocities over +!! the previous timestep. This subroutine is called from vertvisc. subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & maxvel, minvel, str, a, hv) - integer, intent(in) :: i, J - 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),SZJB_(G),SZK_(G)), intent(in) :: vm - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: hin - type(accel_diag_ptrs), intent(in) :: ADp - type(cont_diag_ptrs), intent(in) :: CDp - real, intent(in) :: dt !< The ocean dynamics time step, in s. - type(PointAccel_CS), pointer :: CS - real, intent(in) :: maxvel, minvel - real, optional, intent(in) :: str - real, dimension(SZI_(G),SZK_(G)), optional, intent(in) :: a, hv + integer, intent(in) :: i !< The zonal index of the column to be documented. + integer, intent(in) :: J !< The meridional index of the column to be + !! documented. + 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),SZJB_(G),SZK_(G)), & + intent(in) :: vm !< The new meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: hin !< The layer thickness, in m. + type(accel_diag_ptrs), intent(in) :: ADp !< A structure pointing to the various + !! accelerations in the momentum equations. + type(cont_diag_ptrs), intent(in) :: CDp !< A structure with pointers to various terms in + !! the continuity equations. + real, intent(in) :: dt !< The ocean dynamics time step, in s. + type(PointAccel_CS), pointer :: CS !< The control structure returned by a previous + !! call to PointAccel_init. + real, intent(in) :: maxvel, minvel + real, optional, intent(in) :: str !< The surface wind stress integrated over a time + !! step, in m2 s-1. + real, dimension(SZI_(G),SZK_(G)), & + optional, intent(in) :: a !< The layer coupling coefficients from + !! vertvisc, m. + real, dimension(SZI_(G),SZK_(G)), & + optional, intent(in) :: hv !< The layer thicknesses at velocity grid points, + !! from vertvisc, in m. ! This subroutine writes to an output file all of the accelerations ! that have been applied to a column of meridional velocities over @@ -767,14 +799,23 @@ subroutine write_v_accel(i, J, vm, hin, ADp, CDp, dt, G, GV, CS, & end subroutine write_v_accel +! #@# This subroutine needs a doxygen description subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) - type(ocean_internal_state), target, intent(in) :: MIS - type(time_type), target, intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(directories), intent(in) :: dirs - type(PointAccel_CS), pointer :: CS + type(ocean_internal_state), & + target, intent(in) :: MIS !< For "MOM Internal State" a set of pointers + !! to the fields and accelerations that make + !! up the ocean's physical state. + type(time_type), target, intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(directories), intent(in) :: dirs !< A structure containing several relevant + !! directory paths. + type(PointAccel_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. + ! Arguments: MIS - For "MOM Internal State" a set of pointers to the fields and ! accelerations that make up the ocean's physical state. ! (in) Time - The current model time. @@ -787,7 +828,7 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_PointAccel" ! This module's name. + character(len=40) :: mdl = "MOM_PointAccel" ! This module's name. if (associated(CS)) return allocate(CS) @@ -801,18 +842,18 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%v_av => MIS%v_av; if (.not.associated(MIS%v_av)) CS%v_av => MIS%v(:,:,:) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "U_TRUNC_FILE", CS%u_trunc_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & "The absolute path to the file where the accelerations \n"//& "leading to zonal velocity truncations are written. \n"//& "Leave this empty for efficiency if this diagnostic is \n"//& "not needed.", default="") - call get_param(param_file, mod, "V_TRUNC_FILE", CS%v_trunc_file, & + call get_param(param_file, mdl, "V_TRUNC_FILE", CS%v_trunc_file, & "The absolute path to the file where the accelerations \n"//& "leading to meridional velocity truncations are written. \n"//& "Leave this empty for efficiency if this diagnostic is \n"//& "not needed.", default="") - call get_param(param_file, mod, "MAX_TRUNC_FILE_SIZE_PER_PE", CS%max_writes, & + call get_param(param_file, mdl, "MAX_TRUNC_FILE_SIZE_PER_PE", CS%max_writes, & "The maximum number of colums of truncations that any PE \n"//& "will write out during a run.", default=50) @@ -821,8 +862,8 @@ subroutine PointAccel_init(MIS, Time, G, param_file, diag, dirs, CS) CS%u_trunc_file = trim(dirs%output_directory)//trim(CS%u_trunc_file) if (len_trim(CS%v_trunc_file) > 0) & CS%v_trunc_file = trim(dirs%output_directory)//trim(CS%v_trunc_file) - call log_param(param_file, mod, "output_dir/U_TRUNC_FILE", CS%u_trunc_file) - call log_param(param_file, mod, "output_dir/V_TRUNC_FILE", CS%v_trunc_file) + call log_param(param_file, mdl, "output_dir/U_TRUNC_FILE", CS%u_trunc_file) + call log_param(param_file, mdl, "output_dir/V_TRUNC_FILE", CS%v_trunc_file) endif CS%u_file = -1 ; CS%v_file = -1 ; CS%cols_written = 0 diff --git a/src/diagnostics/MOM_debugging.F90 b/src/diagnostics/MOM_debugging.F90 index 794ba858c2..8c4f9651a8 100644 --- a/src/diagnostics/MOM_debugging.F90 +++ b/src/diagnostics/MOM_debugging.F90 @@ -93,15 +93,15 @@ subroutine MOM_debugging_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_debugging" ! This module's name. + character(len=40) :: mdl = "MOM_debugging" ! This module's name. - call log_version(param_file, mod, version) - call get_param(param_file, mod, "DEBUG", debug, & + call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "DEBUG", debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "DEBUG_CHKSUMS", debug_chksums, & + call get_param(param_file, mdl, "DEBUG_CHKSUMS", debug_chksums, & "If true, checksums are performed on arrays in the \n"//& "various vec_chksum routines.", default=debug) - call get_param(param_file, mod, "DEBUG_REDUNDANT", debug_redundant, & + call get_param(param_file, mdl, "DEBUG_REDUNDANT", debug_redundant, & "If true, debug redundant data points during calls to \n"//& "the various vec_chksum routines.", default=debug) @@ -834,23 +834,35 @@ logical function check_column_integral(nk, field, known_answer) end function check_column_integral !> Returns false if the column integrals of two given quantities are within roundoff of each other -logical function check_column_integrals(nk_1, field_1, nk_2, field_2) - integer, intent(in) :: nk_1 !< Number of levels in field 1 - integer, intent(in) :: nk_2 !< Number of levels in field 2 - real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed - real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed +logical function check_column_integrals(nk_1, field_1, nk_2, field_2, missing_value) + integer, intent(in) :: nk_1 !< Number of levels in field 1 + integer, intent(in) :: nk_2 !< Number of levels in field 2 + real, dimension(nk_1), intent(in) :: field_1 !< First field to be summed + real, dimension(nk_2), intent(in) :: field_2 !< Second field to be summed + real, optional, intent(in) :: missing_value !< If column contains missing values, + !! mask them from the sum + ! Local variables - real :: u1_sum, error1, u2_sum, error2 + real :: u1_sum, error1, u2_sum, error2, misval integer :: k + ! Assign missing value + if (present(missing_value)) then + misval = missing_value + else + misval = 0. + endif + u1_sum = field_1(1) error1 = 0. ! Reintegrate and sum roundoff errors do k=2,nk_1 - u1_sum = u1_sum + field_1(k) - error1 = error1 + EPSILON(u1_sum)*MAX(ABS(u1_sum),ABS(field_1(k))) + if (field_1(k)/=misval) then + u1_sum = u1_sum + field_1(k) + error1 = error1 + EPSILON(u1_sum)*MAX(ABS(u1_sum),ABS(field_1(k))) + endif enddo u2_sum = field_2(1) @@ -858,8 +870,10 @@ logical function check_column_integrals(nk_1, field_1, nk_2, field_2) ! Reintegrate and sum roundoff errors do k=2,nk_2 - u2_sum = u2_sum + field_2(k) - error2 = error2 + EPSILON(u2_sum)*MAX(ABS(u2_sum),ABS(field_2(k))) + if (field_2(k)/=misval) then + u2_sum = u2_sum + field_2(k) + error2 = error2 + EPSILON(u2_sum)*MAX(ABS(u2_sum),ABS(field_2(k))) + endif enddo ! Compare the column integrals against calculated roundoff error diff --git a/src/diagnostics/MOM_diag_to_Z.F90 b/src/diagnostics/MOM_diag_to_Z.F90 index b9af982ac2..1b342507eb 100644 --- a/src/diagnostics/MOM_diag_to_Z.F90 +++ b/src/diagnostics/MOM_diag_to_Z.F90 @@ -162,15 +162,22 @@ function global_z_mean(var,G,CS,tracer) end function global_z_mean +!> This subroutine maps tracers and velocities into depth space for diagnostics. subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_in + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, + !! in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: ssh_in !< Sea surface height + !! (meter or kg/m2). real, dimension(:,:), pointer :: frac_shelf_h - type(diag_to_Z_CS), pointer :: CS + type(diag_to_Z_CS), pointer :: CS !< Control structure returned by + !! previous call to + !! diagnostics_init. ! This subroutine maps tracers and velocities into depth space for diagnostics. @@ -516,15 +523,23 @@ subroutine calculate_Z_diag_fields(u, v, h, ssh_in, frac_shelf_h, G, GV, CS) end subroutine calculate_Z_diag_fields - +!> This subroutine maps horizontal transport into depth space for diagnostic output. subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh_int - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, intent(in) :: dt !< The time difference in s since the last call to this subroutine - type(diag_to_Z_CS), pointer :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh_int !< Time integrated zonal + !! transport (m3 or kg). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh_int !< Time integrated meridional + !! transport (m3 or kg). + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, intent(in) :: dt !< The time difference in s since + !! the last call to this + !! subroutine. + type(diag_to_Z_CS), pointer :: CS !< Control structure returned by + !! previous call to + !! diagnostics_init. ! This subroutine maps horizontal transport into depth space for diagnostic output. @@ -678,13 +693,24 @@ subroutine calculate_Z_transport(uh_int, vh_int, h, dt, G, GV, CS) end subroutine calculate_Z_transport - +!> This subroutine determines the layers bounded by interfaces e that overlap +!! with the depth range between Z_top and Z_bot, and the fractional weights +!! of each layer. It also calculates the normalized relative depths of the range +!! of each layer that overlaps that depth range. subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z2) - real, dimension(:), intent(in) :: e - real, intent(in) :: Z_top, Z_bot - integer, intent(in) :: k_max, k_start - integer, intent(inout) :: k_top, k_bot - real, dimension(:), intent(out) :: wt, z1, z2 + real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2). + real, intent(in) :: Z_top !< Top of range being mapped to (meter or kg/m2). + real, intent(in) :: Z_bot !< Bottom of range being mapped to (meter or kg/m2). + integer, intent(in) :: k_max !< Number of valid layers. + integer, intent(in) :: k_start !< Layer at which to start searching. + integer, intent(inout) :: k_top !< Indices of top layers that overlap with the depth + !! range. + integer, intent(inout) :: k_bot !< Indices of bottom layers that overlap with the + !! depth range. + real, dimension(:), intent(out) :: wt !< Relative weights of each layer from k_top to k_bot. + real, dimension(:), intent(out) :: z1, z2 !< Depths of the top and bottom limits of the part of + !! a layer that contributes to a depth level, relative to the cell center and normalized + !! by the cell thickness (nondim). Note that -1/2 <= z1 < z2 <= 1/2. ! This subroutine determines the layers bounded by interfaces e that overlap ! with the depth range between Z_top and Z_bot, and the fractional weights @@ -745,12 +771,13 @@ subroutine find_overlap(e, Z_top, Z_bot, k_max, k_start, k_top, k_bot, wt, z1, z end subroutine find_overlap - +!> This subroutine determines a limited slope for val to be advected with +!! a piecewise limited scheme. subroutine find_limited_slope(val, e, slope, k) - real, dimension(:), intent(in) :: val - real, dimension(:), intent(in) :: e - real, intent(out) :: slope - integer, intent(in) :: k + real, dimension(:), intent(in) :: val !< A column of values that are being interpolated. + real, dimension(:), intent(in) :: e !< Column interface heights (meter or kg/m2). + real, intent(out) :: slope !< Normalized slope in the intracell distribution of val. + integer, intent(in) :: k !< Layer whose slope is being determined. ! This subroutine determines a limited slope for val to be advected with ! a piecewise limited scheme. @@ -779,13 +806,16 @@ subroutine find_limited_slope(val, e, slope, k) end subroutine find_limited_slope +! #@# This subroutine needs a doxygen description subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). type(p3d), dimension(:), intent(in) :: in_ptrs integer, dimension(:), intent(in) :: ids integer, intent(in) :: num_diags - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. type(diag_to_Z_CS), pointer :: CS real, dimension(SZI_(G),SZJ_(G),max(CS%nk_zspace+1,1),max(num_diags,1)) :: & @@ -874,20 +904,24 @@ subroutine calc_Zint_diags(h, in_ptrs, ids, num_diags, G, GV, CS) end subroutine calc_Zint_diags +!> This subroutine registers a tracer to be output in depth space. subroutine register_Z_tracer(tr_ptr, name, long_name, units, Time, G, CS, standard_name, & cmor_field_name, cmor_long_name, cmor_units, cmor_standard_name) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: tr_ptr - character(len=*), intent(in) :: name - character(len=*), intent(in) :: long_name - character(len=*), intent(in) :: units - character(len=*), optional, intent(in) :: standard_name - type(time_type), intent(in) :: Time - type(diag_to_Z_CS), pointer :: CS - character(len=*), optional, intent(in) :: cmor_field_name - character(len=*), optional, intent(in) :: cmor_long_name - character(len=*), optional, intent(in) :: cmor_units - character(len=*), optional, intent(in) :: cmor_standard_name + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. + character(len=*), intent(in) :: name !< name for the output tracer. + character(len=*), intent(in) :: long_name !< Long name for the output tracer. + character(len=*), intent(in) :: units !< Units of output tracer. + character(len=*), optional, intent(in) :: standard_name + type(time_type), intent(in) :: Time !< Current model time. + type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous + !! call to diagnostics_init. + character(len=*), optional, intent(in) :: cmor_field_name !< cmor name of a field. + character(len=*), optional, intent(in) :: cmor_long_name !< cmor long name of a field. + character(len=*), optional, intent(in) :: cmor_units !< cmor units of a field. + character(len=*), optional, intent(in) :: cmor_standard_name !< cmor standardized name + !! associated with a field. ! This subroutine registers a tracer to be output in depth space. ! Arguments: @@ -942,15 +976,18 @@ subroutine register_Z_tracer(tr_ptr, name, long_name, units, Time, G, CS, standa end subroutine register_Z_tracer +!> This subroutine registers a tracer to be output in depth space. subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, Time, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: tr_ptr - character(len=*), intent(in) :: name - character(len=*), intent(in) :: long_name - character(len=*), intent(in) :: units - character(len=*), intent(in) :: standard_name - type(time_type), intent(in) :: Time - type(diag_to_Z_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. + character(len=*), intent(in) :: name !< Name for the output tracer. + character(len=*), intent(in) :: long_name !< Long name for output tracer. + character(len=*), intent(in) :: units !< Units of output tracer. + character(len=*), intent(in) :: standard_name + type(time_type), intent(in) :: Time !< Current model time. + type(diag_to_Z_CS), pointer :: CS !< Control struct returned by previous call to + !! diagnostics_init. ! This subroutine registers a tracer to be output in depth space. @@ -1005,13 +1042,16 @@ subroutine register_Z_tracer_low(tr_ptr, name, long_name, units, standard_name, end subroutine register_Z_tracer_low +! #@# This subroutine needs a doxygen comment. subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(diag_to_Z_CS), pointer :: CS + type(time_type), intent(in) :: Time !< Current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(inout) :: diag !< Struct to regulate diagnostic output. + type(diag_to_Z_CS), pointer :: CS !< Pointer to point to control structure for + !! this module. ! Arguments: ! (in) Time - current model time @@ -1024,7 +1064,7 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diag_to_Z" ! module name + character(len=40) :: mdl = "MOM_diag_to_Z" ! module name character(len=200) :: in_dir, zgrid_file ! strings for directory/file character(len=48) :: flux_units, string integer :: z_axis, zint_axis @@ -1045,22 +1085,22 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) CS%diag => diag ! Read parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") ! Read in z-space info from a NetCDF file. - call get_param(param_file, mod, "Z_OUTPUT_GRID_FILE", zgrid_file, & + call get_param(param_file, mdl, "Z_OUTPUT_GRID_FILE", zgrid_file, & "The file that specifies the vertical grid for \n"//& "depth-space diagnostics, or blank to disable \n"//& "depth-space output.", default="") if (len_trim(zgrid_file) > 0) then - call get_param(param_file, mod, "INPUTDIR", in_dir, & + call get_param(param_file, mdl, "INPUTDIR", in_dir, & "The directory in which input files are found.", default=".") in_dir = slasher(in_dir) call get_Z_depths(trim(in_dir)//trim(zgrid_file), "zw", CS%Z_int, "zt", & z_axis, zint_axis, CS%nk_zspace) - call log_param(param_file, mod, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & + call log_param(param_file, mdl, "!INPUTDIR/Z_OUTPUT_GRID_FILE", & trim(in_dir)//trim(zgrid_file)) - call log_param(param_file, mod, "!NK_ZSPACE (from file)", CS%nk_zspace, & + call log_param(param_file, mdl, "!NK_ZSPACE (from file)", CS%nk_zspace, & "The number of depth-space levels. This is determined \n"//& "from the size of the variable zw in the output grid file.", & units="nondim") @@ -1106,7 +1146,10 @@ subroutine MOM_diag_to_Z_init(Time, G, GV, param_file, diag, CS) end subroutine MOM_diag_to_Z_init - +!> This subroutine reads the depths of the interfaces bounding the intended +!! layers from a NetCDF file. If no appropriate file is found, -1 is returned +!! as the number of layers in the output file. Also, a diag_manager axis is set +!! up with the same information as this axis. subroutine get_Z_depths(depth_file, int_depth_name, int_depth, cell_depth_name, & z_axis_index, edge_index, nk_out) character(len=*), intent(in) :: depth_file @@ -1241,13 +1284,16 @@ subroutine MOM_diag_to_Z_end(CS) end subroutine MOM_diag_to_Z_end +!> This subroutine registers a tracer to be output in depth space. function ocean_register_diag_with_z(tr_ptr, vardesc_tr, G, Time, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), target, intent(in) :: tr_ptr - type(vardesc), intent(in) :: vardesc_tr - type(time_type), intent(in) :: Time - type(diag_to_Z_CS), pointer :: CS - integer :: ocean_register_diag_with_z + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + target, intent(in) :: tr_ptr !< Tracer for translation to Z-space. + type(vardesc), intent(in) :: vardesc_tr !< Variable descriptor. + type(time_type), intent(in) :: Time !< Current model time. + type(diag_to_Z_CS), pointer :: CS !< Control struct returned by a previous + !! call to diagnostics_init. + integer :: ocean_register_diag_with_z ! This subroutine registers a tracer to be output in depth space. ! Arguments: diff --git a/src/diagnostics/MOM_diagnostics.F90 b/src/diagnostics/MOM_diagnostics.F90 index b14431246a..0473a7e43e 100644 --- a/src/diagnostics/MOM_diagnostics.F90 +++ b/src/diagnostics/MOM_diagnostics.F90 @@ -168,39 +168,59 @@ module MOM_diagnostics end type diagnostics_CS contains - +!> Diagnostics not more naturally calculated elsewhere are computed here. subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & dt, G, GV, CS, eta_bt) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(accel_diag_ptrs), intent(in) :: ADp - type(cont_diag_ptrs), intent(in) :: CDp - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The time difference in s since the last call to this subroutine - type(diagnostics_CS), intent(inout) :: CS - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, + !! in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Transport through zonal faces + !! = u*h*dy, m3/s(Bouss) + !! kg/s(non-Bouss). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< transport through meridional + !! faces = v*h*dx, m3/s(Bouss) + !! kg/s(non-Bouss). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to + !! various thermodynamic + !! variables. + type(accel_diag_ptrs), intent(in) :: ADp !< structure with pointers to + !! accelerations in momentum + !! equation. + type(cont_diag_ptrs), intent(in) :: CDp !< structure with pointers to + !! terms in continuity equation. + type(forcing), intent(in) :: fluxes !< A structure containing the + !! surface fluxes. + real, intent(in) :: dt !< The time difference in s since + !! the last call to this + !! subroutine. + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by + !! a previous call to + !! diagnostics_init. + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: eta_bt !< An optional barotropic + !! variable that gives the "correct" free surface height (Boussinesq) or total water column + !! mass per unit area (non-Boussinesq). This is used to dilate the layer thicknesses when + !! calculating interface heights, in m or kg m-2. ! Diagnostics not more naturally calculated elsewhere are computed here. ! Arguments: -! (in) u - zonal velocity component (m/s) -! (in) v - meridional velocity component (m/s) -! (in) h - layer thickness, meter(Bouss) kg/m^2(non-Bouss) -! (in) uh - transport through zonal faces = u*h*dy, m3/s(Bouss) kg/s(non-Bouss) -! (in) vh - transport through meridional faces = v*h*dx, m3/s(Bouss) kg/s(non-Bouss) +! (in) u - zonal velocity component (m/s). +! (in) v - meridional velocity component (m/s). +! (in) h - layer thickness, meter(Bouss) kg/m^2(non-Bouss). +! (in) uh - transport through zonal faces = u*h*dy, m3/s(Bouss) kg/s(non-Bouss). +! (in) vh - transport through meridional faces = v*h*dx, m3/s(Bouss) kg/s(non-Bouss). ! (in) tv - structure pointing to various thermodynamic variables. -! (in) ADp - structure with pointers to accelerations in momentum equation -! (in) CDp - structure with pointers to terms in continuity equation -! (in) dt - time difference in s since the last call to this subroutine +! (in) ADp - structure with pointers to accelerations in momentum equation. +! (in) CDp - structure with pointers to terms in continuity equation. +! (in) dt - time difference in s since the last call to this subroutine. ! (in) G - ocean grid structure. ! (in) GV - The ocean's vertical grid structure. -! (in) CS - control structure returned by a previous call to diagnostics_init +! (in) CS - control structure returned by a previous call to diagnostics_init. ! (in,opt) eta_bt - An optional barotropic variable that gives the "correct" ! free surface height (Boussinesq) or total water column ! mass per unit area (non-Boussinesq). This is used to @@ -620,7 +640,10 @@ subroutine calculate_diagnostic_fields(u, v, h, uh, vh, tv, ADp, CDp, fluxes, & end subroutine calculate_diagnostic_fields - +!> This subroutine finds location of R_in in an increasing ordered +!! list, Rlist, returning as k the element such that +!! Rlist(k) <= R_in < Rlist(k+1), and where wt and wt_p are the linear +!! weights that should be assigned to elements k and k+1. subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) real, intent(in) :: Rlist(:), R_in integer, intent(inout) :: k @@ -681,13 +704,22 @@ subroutine find_weights(Rlist, R_in, k, nz, wt, wt_p) end subroutine find_weights +!> Subroutine calculates vertical integrals of several tracers, along +!! with the mass-weight of these tracers, the total column mass, and the +!! carefully calculated column height. subroutine calculate_vertical_integrals(h, tv, fluxes, G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(forcing), intent(in) :: fluxes - type(diagnostics_CS), intent(inout) :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(forcing), intent(in) :: fluxes !< A structure containing the + !! surface fluxes. + type(diagnostics_CS), intent(inout) :: CS !< A control structure returned + !! by a previous call to + !! diagnostics_init. ! Subroutine calculates vertical integrals of several tracers, along ! with the mass-weight of these tracers, the total column mass, and the @@ -802,17 +834,28 @@ subroutine calculate_vertical_integrals(h, tv, fluxes, G, GV, CS) end subroutine calculate_vertical_integrals - +!> This subroutine calculates terms in the mechanical energy budget. subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh - type(accel_diag_ptrs), intent(in) :: ADp - type(cont_diag_ptrs), intent(in) :: CDp - type(diagnostics_CS), intent(inout) :: CS + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, + !! in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uh !< Transport through zonal + !! faces=u*h*dy: m3/s (Bouss) + !! kg/s(non-Bouss). + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vh !< Transport through merid + !! faces=v*h*dx: m3/s (Bouss) + !! kg/s(non-Bouss). + type(accel_diag_ptrs), intent(in) :: ADp !< Structure pointing to + !! accelerations in momentum + !! equation. + type(cont_diag_ptrs), intent(in) :: CDp !< Structure pointing to terms + !! in continuity equations. + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by + !! a previous call to + !! diagnostics_init. ! This subroutine calculates terms in the mechanical energy budget. @@ -1001,10 +1044,13 @@ subroutine calculate_energy_diagnostics(u, v, h, uh, vh, ADp, CDp, G, CS) end subroutine calculate_energy_diagnostics - +!> This subroutine registers fields to calculate a diagnostic time derivative. subroutine register_time_deriv(f_ptr, deriv_ptr, CS) - real, dimension(:,:,:), target :: f_ptr, deriv_ptr - type(diagnostics_CS), pointer :: CS + real, dimension(:,:,:), target :: f_ptr !< Field whose derivative is taken. + real, dimension(:,:,:), target :: deriv_ptr !< Field in which the calculated time derivatives + !! placed. + type(diagnostics_CS), pointer :: CS !< Control structure returned by previous call to + !! diagnostics_init. ! This subroutine registers fields to calculate a diagnostic time derivative. ! Arguments: @@ -1035,11 +1081,13 @@ subroutine register_time_deriv(f_ptr, deriv_ptr, CS) end subroutine register_time_deriv - +!> This subroutine calculates all registered time derivatives. subroutine calculate_derivs(dt, G, CS) - real, intent(in) :: dt !< The time interval over which differences occur, in s - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(diagnostics_CS), intent(inout) :: CS + real, intent(in) :: dt !< The time interval over which differences occur, + !! in s. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(diagnostics_CS), intent(inout) :: CS !< Control structure returned by previous call to + !! diagnostics_init. ! This subroutine calculates all registered time derivatives. ! Arguments: @@ -1062,16 +1110,23 @@ subroutine calculate_derivs(dt, G, CS) end subroutine calculate_derivs +! #@# This subroutine needs a doxygen description subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS) - type(ocean_internal_state), intent(in) :: MIS - type(accel_diag_ptrs), intent(inout) :: ADp - type(cont_diag_ptrs), intent(inout) :: CDp - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(diagnostics_CS), pointer :: CS + type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to + !! the fields and accelerations that make up the + !! ocean's internal physical state. + type(accel_diag_ptrs), intent(inout) :: ADp !< Structure with pointers to momentum equation + !! terms. + type(cont_diag_ptrs), intent(inout) :: CDp !< Structure with pointers to continuity + !! equation terms. + type(time_type), intent(in) :: Time !< Current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(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. + type(diagnostics_CS), pointer :: CS !< Pointer set to point to control structure + !! for this module. ! Arguments ! (in) MIS - For "MOM Internal State" a set of pointers to the fields and @@ -1090,7 +1145,7 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diagnostics" ! This module's name. + character(len=40) :: mdl = "MOM_diagnostics" ! This module's name. real :: omega, f2_min character(len=48) :: thickness_units, flux_units integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz, nkml, nkbl @@ -1111,12 +1166,12 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version) - call get_param(param_file, mod, "DIAG_EBT_MONO_N2_COLUMN_FRACTION", CS%mono_N2_column_fraction, & + call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_COLUMN_FRACTION", CS%mono_N2_column_fraction, & "The lower fraction of water column over which N2 is limited as monotonic\n"// & "for the purposes of calculating the equivalent barotropic wave speed.", & units='nondim', default=0.) - call get_param(param_file, mod, "DIAG_EBT_MONO_N2_DEPTH", CS%mono_N2_depth, & + call get_param(param_file, mdl, "DIAG_EBT_MONO_N2_DEPTH", CS%mono_N2_depth, & "The depth below which N2 is limited as monotonic for the\n"// & "purposes of calculating the equivalent barotropic wave speed.", & units='m', default=-1.) @@ -1329,13 +1384,18 @@ subroutine MOM_diagnostics_init(MIS, ADp, CDp, Time, G, GV, param_file, diag, CS end subroutine MOM_diagnostics_init - +!> This subroutine sets up diagnostics upon which other diagnostics depend. subroutine set_dependent_diagnostics(MIS, ADp, CDp, G, CS) - type(ocean_internal_state), intent(in) :: MIS - type(accel_diag_ptrs), intent(inout) :: ADp - type(cont_diag_ptrs), intent(inout) :: CDp - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(diagnostics_CS), pointer :: CS + type(ocean_internal_state), intent(in) :: MIS !< For "MOM Internal State" a set of pointers to + !! the fields and accelerations making up ocean + !! internal physical state. + type(accel_diag_ptrs), intent(inout) :: ADp !< Structure pointing to accelerations in + !! momentum equation. + type(cont_diag_ptrs), intent(inout) :: CDp !< Structure pointing to terms in continuity + !! equation. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(diagnostics_CS), pointer :: CS !< Pointer to the control structure for this + !! module. ! This subroutine sets up diagnostics upon which other diagnostics depend. ! Arguments: diff --git a/src/diagnostics/MOM_obsolete_diagnostics.F90 b/src/diagnostics/MOM_obsolete_diagnostics.F90 index 4b498292d7..4cf55bad3b 100644 --- a/src/diagnostics/MOM_obsolete_diagnostics.F90 +++ b/src/diagnostics/MOM_obsolete_diagnostics.F90 @@ -25,12 +25,12 @@ subroutine register_obsolete_diagnostics(param_file, diag) ! This include declares and sets the variable "version". #include "version_variable.h" ! Local variables - character(len=40) :: mod = "MOM_obsolete_diagnostics" !< This module's name. + character(len=40) :: mdl = "MOM_obsolete_diagnostics" !< This module's name. logical :: foundEntry, causeFatal integer :: errType - call log_version(param_file, mod, version) - call get_param(param_file, mod, "OBSOLETE_DIAGNOSTIC_IS_FATAL", causeFatal, & + call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "OBSOLETE_DIAGNOSTIC_IS_FATAL", causeFatal, & "If an obsolete diagnostic variable appears in the diag_table\n"// & "then cause a FATAL error rather than issue a WARNING.", default=.true.) diff --git a/src/diagnostics/MOM_obsolete_params.F90 b/src/diagnostics/MOM_obsolete_params.F90 index 935c320cf4..906063f6f8 100644 --- a/src/diagnostics/MOM_obsolete_params.F90 +++ b/src/diagnostics/MOM_obsolete_params.F90 @@ -20,7 +20,7 @@ module MOM_obsolete_params subroutine find_obsolete_params(param_file) type(param_file_type), intent(in) :: param_file !< Structure containing parameter file data. ! Local variables - character(len=40) :: mod = "find_obsolete_params" ! This module's name. + character(len=40) :: mdl = "find_obsolete_params" ! This module's name. ! This include declares and sets the variable "version". #include "version_variable.h" integer :: test_int @@ -190,7 +190,7 @@ subroutine find_obsolete_params(param_file) call obsolete_logical(param_file, "MSTAR_FIXED", hint="Instead use MSTAR_MODE.") ! Write the file version number to the model log. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) end subroutine find_obsolete_params diff --git a/src/diagnostics/MOM_sum_output.F90 b/src/diagnostics/MOM_sum_output.F90 index 013daac2f7..2284375ad7 100644 --- a/src/diagnostics/MOM_sum_output.F90 +++ b/src/diagnostics/MOM_sum_output.F90 @@ -158,14 +158,19 @@ module MOM_sum_output contains +! #@# This subroutine needs a doxygen description. subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & Input_start_time, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - character(len=*), intent(in) :: directory - integer, target, intent(inout) :: ntrnc - type(time_type), intent(in) :: Input_start_time - type(Sum_output_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + character(len=*), intent(in) :: directory !< The directory where the energy file goes. + integer, target, intent(inout) :: ntrnc !< The integer that stores the number of times + !! the velocity has been truncated since the + !! last call to write_energy. + type(time_type), intent(in) :: Input_start_time !< The start time of the simulation. + type(Sum_output_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. ! Arguments: G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for ! model parameter values. @@ -178,7 +183,7 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & real :: Rho_0, maxvel ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_sum_output" ! This module's name. + character(len=40) :: mdl = "MOM_sum_output" ! This module's name. character(len=200) :: energyfile ! The name of the energy file. character(len=32) :: filename_appendix = '' !fms appendix to filename for ensemble runs @@ -189,42 +194,42 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CALCULATE_APE", CS%do_APE_calc, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CALCULATE_APE", CS%do_APE_calc, & "If true, calculate the available potential energy of \n"//& "the interfaces. Setting this to false reduces the \n"//& "memory footprint of high-PE-count models dramatically.", & default=.true.) - call get_param(param_file, mod, "WRITE_STOCKS", CS%write_stocks, & + call get_param(param_file, mdl, "WRITE_STOCKS", CS%write_stocks, & "If true, write the integrated tracer amounts to stdout \n"//& "when the energy files are written.", default=.true.) - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "DT", CS%dt, & + call get_param(param_file, mdl, "DT", CS%dt, & "The (baroclinic) dynamics time step.", units="s", & fail_if_missing=.true.) - call get_param(param_file, mod, "MAXTRUNC", CS%maxtrunc, & + call get_param(param_file, mdl, "MAXTRUNC", CS%maxtrunc, & "The run will be stopped, and the day set to a very \n"//& "large value if the velocity is truncated more than \n"//& "MAXTRUNC times between energy saves. Set MAXTRUNC to 0 \n"//& "to stop if there is any truncation of velocities.", & units="truncations save_interval-1", default=0) - call get_param(param_file, mod, "MAX_ENERGY", CS%max_Energy, & + call get_param(param_file, mdl, "MAX_ENERGY", CS%max_Energy, & "The maximum permitted average energy per unit mass; the \n"//& "model will be stopped if there is more energy than \n"//& "this. If zero or negative, this is set to 10*MAXVEL^2.", & units="m2 s-2", default=0.0) if (CS%max_Energy <= 0.0) then - call get_param(param_file, mod, "MAXVEL", maxvel, & + call get_param(param_file, mdl, "MAXVEL", maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8) CS%max_Energy = 10.0 * maxvel**2 - call log_param (param_file, mod, "MAX_ENERGY as used", CS%max_Energy) + call log_param (param_file, mdl, "MAX_ENERGY as used", CS%max_Energy) endif - call get_param(param_file, mod, "ENERGYFILE", energyfile, & + call get_param(param_file, mdl, "ENERGYFILE", energyfile, & "The file to use to write the energies and globally \n"//& "summed diagnostics.", default="ocean.stats") @@ -235,15 +240,15 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & end if CS%energyfile = trim(slasher(directory))//trim(energyfile) - call log_param(param_file, mod, "output_path/ENERGYFILE", CS%energyfile) + call log_param(param_file, mdl, "output_path/ENERGYFILE", CS%energyfile) #ifdef STATSLABEL CS%energyfile = trim(CS%energyfile)//"."//trim(adjustl(STATSLABEL)) #endif - call get_param(param_file, mod, "DATE_STAMPED_STDOUT", CS%date_stamped_output, & + call get_param(param_file, mdl, "DATE_STAMPED_STDOUT", CS%date_stamped_output, & "If true, use dates (not times) in messages to stdout", & default=.true.) - call get_param(param_file, mod, "TIMEUNIT", CS%Timeunit, & + call get_param(param_file, mdl, "TIMEUNIT", CS%Timeunit, & "The time unit in seconds a number of input fields", & units="s", default=86400.0) if (CS%Timeunit < 0.0) CS%Timeunit = 86400.0 @@ -251,15 +256,15 @@ subroutine MOM_sum_output_init(G, param_file, directory, ntrnc, & if (CS%do_APE_calc) then - call get_param(param_file, mod, "READ_DEPTH_LIST", CS%read_depth_list, & + call get_param(param_file, mdl, "READ_DEPTH_LIST", CS%read_depth_list, & "Read the depth list from a file if it exists or \n"//& "create that file otherwise.", default=.false.) - call get_param(param_file, mod, "DEPTH_LIST_MIN_INC", CS%D_list_min_inc, & + call get_param(param_file, mdl, "DEPTH_LIST_MIN_INC", CS%D_list_min_inc, & "The minimum increment between the depths of the \n"//& "entries in the depth-list file.", units="m", & default=1.0E-10) if (CS%read_depth_list) then - call get_param(param_file, mod, "DEPTH_LIST_FILE", CS%depth_list_file, & + call get_param(param_file, mdl, "DEPTH_LIST_FILE", CS%depth_list_file, & "The name of the depth list file.", default="Depth_list.nc") if (scan(CS%depth_list_file,'/') == 0) & CS%depth_list_file = trim(slasher(directory))//trim(CS%depth_list_file) @@ -293,16 +298,26 @@ subroutine MOM_sum_output_end(CS) endif end subroutine MOM_sum_output_end +!> This subroutine calculates and writes the total model energy, the +!! energy and mass of each layer, and other globally integrated +!! physical quantities. subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp) - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(time_type), intent(inout) :: day - integer, intent(in) :: n - type(Sum_output_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, + !! in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(time_type), intent(inout) :: day !< The current model time. + integer, intent(in) :: n !< The time step number of the + !! current execution. + type(Sum_output_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! MOM_sum_output_init. type(tracer_flow_control_CS), optional, pointer :: tracer_CSp @@ -869,12 +884,15 @@ subroutine write_energy(u, v, h, tv, day, n, G, GV, CS, tracer_CSp) endif end subroutine write_energy +!> This subroutine accumates the net input of volume, and perhaps later salt and +!! heat, through the ocean surface for use in diagnosing conservation. subroutine accumulate_net_input(fluxes, state, dt, G, CS) - type(forcing), intent(in) :: fluxes + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any possible forcing fields. Unused fields are unallocated. type(surface), intent(in) :: state - real, intent(in) :: dt !< The amount of time over which to average, in s - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(Sum_output_CS), pointer :: CS + real, intent(in) :: dt !< The amount of time over which to average, in s. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(Sum_output_CS), pointer :: CS !< The control structure returned by a previous call to MOM_sum_output_init. + ! This subroutine accumates the net input of volume, and perhaps later salt and ! heat, through the ocean surface for use in diagnosing conservation. ! Arguments: fluxes - A structure containing pointers to any possible @@ -992,7 +1010,10 @@ subroutine accumulate_net_input(fluxes, state, dt, G, CS) end subroutine accumulate_net_input - +!> This subroutine sets up an ordered list of depths, along with the +!! cross sectional areas at each depth and the volume of fluid deeper +!! than each depth. This might be read from a previously created file +!! or it might be created anew. (For now only new creation occurs. subroutine depth_list_setup(G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(Sum_output_CS), pointer :: CS @@ -1026,7 +1047,7 @@ end subroutine depth_list_setup !> create_depth_list makes an ordered list of depths, along with the cross !! sectional areas at each depth and the volume of fluid deeper than each depth. subroutine create_depth_list(G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS !< The control structure set up in MOM_sum_output_init, !! in which the ordered depth list is stored. @@ -1149,8 +1170,9 @@ subroutine create_depth_list(G, CS) end subroutine create_depth_list +!> This subroutine writes out the depth list to the specified file. subroutine write_depth_list(G, CS, filename, list_size) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(Sum_output_CS), pointer :: CS character(len=*), intent(in) :: filename integer, intent(in) :: list_size @@ -1229,6 +1251,8 @@ subroutine write_depth_list(G, CS, filename, list_size) end subroutine write_depth_list +!> This subroutine reads in the depth list to the specified file +!! and allocates and sets up CS%DL and CS%list_size . subroutine read_depth_list(G, CS, filename) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(Sum_output_CS), pointer :: CS @@ -1236,39 +1260,39 @@ subroutine read_depth_list(G, CS, filename) ! This subroutine reads in the depth list to the specified file ! and allocates and sets up CS%DL and CS%list_size . - character(len=32) :: mod + character(len=32) :: mdl character(len=240) :: var_name, var_msg real, allocatable :: tmp(:) integer :: ncid, status, varid, list_size, k integer :: ndim, len, var_dim_ids(NF90_MAX_VAR_DIMS) - mod = "MOM_sum_output read_depth_list:" + mdl = "MOM_sum_output read_depth_list:" status = NF90_OPEN(filename, NF90_NOWRITE, ncid); if (status /= NF90_NOERR) then - call MOM_error(FATAL,mod//" Difficulties opening "//trim(filename)// & + call MOM_error(FATAL,mdl//" Difficulties opening "//trim(filename)// & " - "//trim(NF90_STRERROR(status))) endif var_name = "depth" var_msg = trim(var_name)//" in "//trim(filename)//" - " status = NF90_INQ_VARID(ncid, var_name, varid) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties finding variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) status = NF90_INQUIRE_VARIABLE(ncid, varid, ndims=ndim, dimids=var_dim_ids) if (status /= NF90_NOERR) then - call MOM_ERROR(FATAL,mod//" cannot inquire about "//trim(var_msg)//& + call MOM_ERROR(FATAL,mdl//" cannot inquire about "//trim(var_msg)//& trim(NF90_STRERROR(status))) elseif (ndim > 1) then - call MOM_ERROR(FATAL,mod//" "//trim(var_msg)//& + call MOM_ERROR(FATAL,mdl//" "//trim(var_msg)//& " has too many or too few dimensions.") endif ! Get the length of the list. status = NF90_INQUIRE_DIMENSION(ncid, var_dim_ids(1), len=list_size) - if (status /= NF90_NOERR) call MOM_ERROR(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_ERROR(FATAL,mdl// & " cannot inquire about dimension(1) of "//trim(var_msg)//& trim(NF90_STRERROR(status))) @@ -1277,7 +1301,7 @@ subroutine read_depth_list(G, CS, filename) allocate(tmp(list_size)) status = NF90_GET_VAR(ncid, varid, tmp) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) @@ -1286,11 +1310,11 @@ subroutine read_depth_list(G, CS, filename) var_name = "area" var_msg = trim(var_name)//" in "//trim(filename)//" - " status = NF90_INQ_VARID(ncid, var_name, varid) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties finding variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) status = NF90_GET_VAR(ncid, varid, tmp) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) @@ -1299,18 +1323,18 @@ subroutine read_depth_list(G, CS, filename) var_name = "vol_below" var_msg = trim(var_name)//" in "//trim(filename) status = NF90_INQ_VARID(ncid, var_name, varid) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties finding variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) status = NF90_GET_VAR(ncid, varid, tmp) - if (status /= NF90_NOERR) call MOM_error(FATAL,mod// & + if (status /= NF90_NOERR) call MOM_error(FATAL,mdl// & " Difficulties reading variable "//trim(var_msg)//& trim(NF90_STRERROR(status))) do k=1,list_size ; CS%DL(k)%vol_below = tmp(k) ; enddo status = NF90_CLOSE(ncid) - if (status /= NF90_NOERR) call MOM_error(WARNING, mod// & + if (status /= NF90_NOERR) call MOM_error(WARNING, mdl// & " Difficulties closing "//trim(filename)//" - "//trim(NF90_STRERROR(status))) deallocate(tmp) diff --git a/src/diagnostics/MOM_wave_speed.F90 b/src/diagnostics/MOM_wave_speed.F90 index 1f377dc2d2..1770ebb4f1 100644 --- a/src/diagnostics/MOM_wave_speed.F90 +++ b/src/diagnostics/MOM_wave_speed.F90 @@ -1091,7 +1091,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de !! as monotonic for the purposes of calculating vertical modal structure. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_wave_speed" ! This module's name. + character(len=40) :: mdl = "MOM_wave_speed" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "wave_speed_init called with an "// & @@ -1100,7 +1100,7 @@ subroutine wave_speed_init(CS, use_ebt_mode, mono_N2_column_fraction, mono_N2_de else ; allocate(CS) ; endif ! Write all relevant parameters to the model log. - call log_version(mod, version) + call log_version(mdl, version) call wave_speed_set_param(CS, use_ebt_mode=use_ebt_mode, mono_N2_column_fraction=mono_N2_column_fraction) diff --git a/src/diagnostics/MOM_wave_structure.F90 b/src/diagnostics/MOM_wave_structure.F90 index af6d1f3f60..80f7a89fed 100644 --- a/src/diagnostics/MOM_wave_structure.F90 +++ b/src/diagnostics/MOM_wave_structure.F90 @@ -89,17 +89,29 @@ module MOM_wave_structure contains +!> This subroutine determines the internal wave velocity structure for any mode. subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) - 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 !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn - integer, intent(in) :: ModeNum - real, intent(in) :: freq - type(wave_structure_CS), pointer :: CS - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: En - logical,optional, intent(in) :: full_halos + 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 !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: cn !< The (non-rotational) mode + !! internal gravity wave speed, + !! in m s-1. + integer, intent(in) :: ModeNum !< Mode number + real, intent(in) :: freq !< Intrinsic wave frequency, in s-1. + type(wave_structure_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! wave_structure_init. + real, dimension(SZI_(G),SZJ_(G)), & + optional, intent(in) :: En !< Internal wave energy density, + !! in Jm-2. + logical,optional, intent(in) :: full_halos !< If true, do the calculation + !! over the entire computational + !! domain. ! This subroutine determines the internal wave velocity structure for any mode. ! Arguments: h - Layer thickness, in m or kg m-2. @@ -600,10 +612,23 @@ subroutine wave_structure(h, tv, G, GV, cn, ModeNum, freq, CS, En, full_halos) end subroutine wave_structure +!> This subroutine solves a tri-diagonal system Ax=y using either the standard +!! Thomas algorithim (TDMA_T) or its more stable variant that invokes the +!! "Hallberg substitution" (TDMA_H). subroutine tridiag_solver(a,b,c,h,y,method,x) - real, dimension(:), intent(in) :: a, b, c, h, y - character(len=*), intent(in) :: method - real, dimension(:), intent(out) :: x + real, dimension(:), intent(in) :: a !< lower diagonal with first entry equal to zero. + real, dimension(:), intent(in) :: b !< middle diagonal. + real, dimension(:), intent(in) :: c !< upper diagonal with last entry equal to zero. + real, dimension(:), intent(in) :: h !< vector of values that have already been added to b; used + !! for systems of the form (e.g. average layer thickness in vertical diffusion case): + !! [ -alpha(k-1/2) ] * e(k-1) + + !! [ alpha(k-1/2) + alpha(k+1/2) + h(k) ] * e(k) + + !! [ -alpha(k+1/2) ] * e(k+1) = y(k) + !! where a(k)=[-alpha(k-1/2)], b(k)=[alpha(k-1/2)+alpha(k+1/2) + h(k)], + !! and c(k)=[-alpha(k+1/2)]. Only used with TDMA_H method. + real, dimension(:), intent(in) :: y !< vector of known values on right hand side. + character(len=*), intent(in) :: method + real, dimension(:), intent(out) :: x !< vector of unknown values to solve for. ! This subroutine solves a tri-diagonal system Ax=y using either the standard ! Thomas algorithim (TDMA_T) or its more stable variant that invokes the @@ -732,11 +757,14 @@ end subroutine tridiag_solver subroutine wave_structure_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(wave_structure_CS), pointer :: CS + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(wave_structure_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -746,7 +774,7 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_wave_structure" ! This module's name. + character(len=40) :: mdl = "MOM_wave_structure" ! This module's name. integer :: isd, ied, jsd, jed, nz isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ; nz = G%ke @@ -757,9 +785,9 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) return else ; allocate(CS) ; endif - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & "Y Location of generation site for internal tide", default=1.) CS%diag => diag @@ -775,7 +803,7 @@ subroutine wave_structure_init(Time, G, param_file, diag, CS) allocate(CS%num_intfaces(isd:ied,jsd:jed)) ! Write all relevant parameters to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") end subroutine wave_structure_init diff --git a/src/equation_of_state/MOM_EOS.F90 b/src/equation_of_state/MOM_EOS.F90 index 8aeee03088..149fe01bb1 100644 --- a/src/equation_of_state/MOM_EOS.F90 +++ b/src/equation_of_state/MOM_EOS.F90 @@ -460,15 +460,15 @@ subroutine EOS_init(param_file, EOS) type(EOS_type), pointer :: EOS !< Equation of state structure ! Local variables #include "version_variable.h" - character(len=40) :: mod = "MOM_EOS" ! This module's name. + character(len=40) :: mdl = "MOM_EOS" ! This module's name. character(len=40) :: tmpstr if (.not.associated(EOS)) call EOS_allocate(EOS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "EQN_OF_STATE", tmpstr, & + call get_param(param_file, mdl, "EQN_OF_STATE", tmpstr, & "EQN_OF_STATE determines which ocean equation of state \n"//& "should be used. Currently, the valid choices are \n"//& '"LINEAR", "UNESCO", "WRIGHT", "NEMO" and "TEOS10". \n'//& @@ -493,25 +493,25 @@ subroutine EOS_init(param_file, EOS) if (EOS%form_of_EOS == EOS_LINEAR) then EOS%Compressible = .false. - call get_param(param_file, mod, "RHO_T0_S0", EOS%Rho_T0_S0, & + call get_param(param_file, mdl, "RHO_T0_S0", EOS%Rho_T0_S0, & "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& "this is the density at T=0, S=0.", units="kg m-3", & default=1000.0) - call get_param(param_file, mod, "DRHO_DT", EOS%dRho_dT, & + call get_param(param_file, mdl, "DRHO_DT", EOS%dRho_dT, & "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& "this is the partial derivative of density with \n"//& "temperature.", units="kg m-3 K-1", default=-0.2) - call get_param(param_file, mod, "DRHO_DS", EOS%dRho_dS, & + call get_param(param_file, mdl, "DRHO_DS", EOS%dRho_dS, & "When EQN_OF_STATE="//trim(EOS_LINEAR_STRING)//", \n"//& "this is the partial derivative of density with \n"//& "salinity.", units="kg m-3 PSU-1", default=0.8) endif - call get_param(param_file, mod, "EOS_QUADRATURE", EOS%EOS_quadrature, & + call get_param(param_file, mdl, "EOS_QUADRATURE", EOS%EOS_quadrature, & "If true, always use the generic (quadrature) code \n"//& "code for the integrals of density.", default=.false.) - call get_param(param_file, mod, "TFREEZE_FORM", tmpstr, & + call get_param(param_file, mdl, "TFREEZE_FORM", tmpstr, & "TFREEZE_FORM determines which expression should be \n"//& "used for the freezing point. Currently, the valid \n"//& 'choices are "LINEAR", "MILLERO_78", "TEOS10"', & @@ -529,16 +529,16 @@ subroutine EOS_init(param_file, EOS) end select if (EOS%form_of_TFreeze == TFREEZE_LINEAR) then - call get_param(param_file, mod, "TFREEZE_S0_P0",EOS%TFr_S0_P0, & + call get_param(param_file, mdl, "TFREEZE_S0_P0",EOS%TFr_S0_P0, & "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& "this is the freezing potential temperature at \n"//& "S=0, P=0.", units="deg C", default=0.0) - call get_param(param_file, mod, "DTFREEZE_DS",EOS%dTFr_dS, & + call get_param(param_file, mdl, "DTFREEZE_DS",EOS%dTFr_dS, & "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& "this is the derivative of the freezing potential \n"//& "temperature with salinity.", & units="deg C PSU-1", default=-0.054) - call get_param(param_file, mod, "DTFREEZE_DP",EOS%dTFr_dP, & + call get_param(param_file, mdl, "DTFREEZE_DP",EOS%dTFr_dP, & "When TFREEZE_FORM="//trim(TFREEZE_LINEAR_STRING)//", \n"//& "this is the derivative of the freezing potential \n"//& "temperature with pressure.", & diff --git a/src/equation_of_state/MOM_EOS_UNESCO.F90 b/src/equation_of_state/MOM_EOS_UNESCO.F90 index cc8b1ae0be..b9e4da723c 100644 --- a/src/equation_of_state/MOM_EOS_UNESCO.F90 +++ b/src/equation_of_state/MOM_EOS_UNESCO.F90 @@ -58,9 +58,17 @@ module MOM_EOS_UNESCO contains +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) from salinity (S in psu), potential temperature +!! (T in deg C), and pressure in Pa. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! Coded by R. Hallberg, 7/00 subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho) -real, intent(in) :: T, S, pressure -real, intent(out) :: rho +real, intent(in) :: T !< Potential temperature relative to the surface in C. +real, intent(in) :: S !< Salinity in PSU. +real, intent(in) :: pressure !< Pressure in Pa. +real, intent(out) :: rho !< In situ density in kg m-3. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in PSU. * ! * (in) pressure - pressure in Pa. * @@ -88,10 +96,17 @@ subroutine calculate_density_scalar_UNESCO(T, S, pressure, rho) end subroutine calculate_density_scalar_UNESCO +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) from salinity (S in psu), potential temperature +!! (T in deg C), and pressure in Pa. subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. ! * This subroutine computes the in situ density of sea water (rho in * ! * units of kg/m^3) from salinity (S in psu), potential temperature * @@ -134,10 +149,20 @@ subroutine calculate_density_array_UNESCO(T, S, pressure, rho, start, npts) enddo end subroutine calculate_density_array_UNESCO +!> This subroutine calculates the partial derivatives of density +!! with potential temperature and salinity. subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: drho_dT, drho_dS - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + ! * This subroutine calculates the partial derivatives of density * ! * with potential temperature and salinity. * ! * * @@ -200,10 +225,21 @@ subroutine calculate_density_derivs_UNESCO(T, S, pressure, drho_dT, drho_dS, sta end subroutine calculate_density_derivs_UNESCO +!> This subroutine computes the in situ density of sea water (rho) +!! and the compressibility (drho/dp == C_sound^-2) at the given +!! salinity, potential temperature, and pressure. subroutine calculate_compress_UNESCO(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho, drho_dp - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! in s2 m-2. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + ! * This subroutine computes the in situ density of sea water (rho) * ! * and the compressibility (drho/dp == C_sound^-2) at the given * ! * salinity, potential temperature, and pressure. * diff --git a/src/equation_of_state/MOM_EOS_Wright.F90 b/src/equation_of_state/MOM_EOS_Wright.F90 index c370a568da..b0354b0815 100644 --- a/src/equation_of_state/MOM_EOS_Wright.F90 +++ b/src/equation_of_state/MOM_EOS_Wright.F90 @@ -60,9 +60,17 @@ module MOM_EOS_Wright contains +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) from salinity (S in psu), potential temperature +!! (T in deg C), and pressure in Pa. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! Coded by R. Hallberg, 7/00 subroutine calculate_density_scalar_wright(T, S, pressure, rho) -real, intent(in) :: T, S, pressure -real, intent(out) :: rho +real, intent(in) :: T !< Potential temperature relative to the surface in C. +real, intent(in) :: S !< Salinity in PSU. +real, intent(in) :: pressure !< Pressure in Pa. +real, intent(out) :: rho !< In situ density in kg m-3. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in PSU. * ! * (in) pressure - pressure in Pa. * @@ -92,10 +100,20 @@ subroutine calculate_density_scalar_wright(T, S, pressure, rho) end subroutine calculate_density_scalar_wright +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) from salinity (S in psu), potential temperature +!! (T in deg C), and pressure in Pa. It uses the expression from +!! Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! Coded by R. Hallberg, 7/00 subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< salinity in PSU. + real, intent(in), dimension(:) :: pressure !< pressure in Pa. + real, intent(out), dimension(:) :: rho !< in situ density in kg m-3. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in PSU. * ! * (in) pressure - pressure in Pa. * @@ -122,10 +140,19 @@ subroutine calculate_density_array_wright(T, S, pressure, rho, start, npts) enddo end subroutine calculate_density_array_wright +! #@# This subroutine needs a doxygen description. subroutine calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: drho_dT, drho_dS - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: drho_dT !< The partial derivative of density with potential + !! temperature, in kg m-3 K-1. + real, intent(out), dimension(:) :: drho_dS !< The partial derivative of density with salinity, + !! in kg m-3 psu-1. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in PSU. * ! * (in) pressure - pressure in Pa. * @@ -156,9 +183,17 @@ subroutine calculate_density_derivs_wright(T, S, pressure, drho_dT, drho_dS, sta end subroutine calculate_density_derivs_wright subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: dSV_dT, dSV_dS - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in g/kg. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature, in m3 kg-1 K-1. + real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity, in m3 kg-1 / (g/kg). + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in g/kg. * ! * (in) pressure - pressure in Pa. * @@ -187,10 +222,24 @@ subroutine calculate_specvol_derivs_wright(T, S, pressure, dSV_dT, dSV_dS, start end subroutine calculate_specvol_derivs_wright +!> This subroutine computes the in situ density of sea water (rho in +!! units of kg/m^3) and the compressibility (drho/dp = C_sound^-2) +!! (drho_dp in units of s2 m-2) from salinity (sal in psu), potential +!! temperature (T in deg C), and pressure in Pa. It uses the expressions +!! from Wright, 1997, J. Atmos. Ocean. Tech., 14, 735-740. +!! Coded by R. Hallberg, 1/01 subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho, drho_dp - integer, intent(in) :: start, npts + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! in s2 m-2. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in PSU. * ! * (in) pressure - pressure in Pa. * @@ -222,20 +271,44 @@ subroutine calculate_compress_wright(T, S, pressure, rho, drho_dp, start, npts) enddo end subroutine calculate_compress_wright +!> This subroutine calculates analytical and nearly-analytical integrals of +!! pressure anomalies across layers, which are required for calculating the +!! finite-volume form pressure accelerations in a Boussinesq model. subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, & dpa, intz_dpa, intx_dpa, inty_dpa) type(hor_index_type), intent(in) :: HII, HIO real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T, S, z_t, z_b - real, intent(in) :: rho_ref, rho_0, G_e + intent(in) :: T !< Potential temperature relative to the surface + !! in C. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: S !< Salinity in PSU. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: z_t !< Height at the top of the layer in m. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: z_b !< Height at the top of the layer in m. + real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted out + !! to reduce the magnitude of each of the integrals. + !! (The pressure is calucated as p~=-z*rho_0*G_e.) + real, intent(in) :: rho_0 !< Density, in kg m-3, that is used to calculate the + !! pressure (as p~=-z*rho_0*G_e) used in the + !! equation of state. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, in m s-2. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(out) :: dpa + intent(out) :: dpa !< The change in the pressure anomaly across the + !! layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - optional, intent(out) :: intz_dpa + optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer + !! of the pressure anomaly relative to the anomaly + !! at the top of the layer, in Pa m. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & - optional, intent(out) :: intx_dpa + optional, intent(out) :: intx_dpa !< The integral in x of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the x grid spacing, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & - optional, intent(out) :: inty_dpa + optional, intent(out) :: inty_dpa !< The integral in y of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the y grid spacing, in Pa. + ! This subroutine calculates analytical and nearly-analytical integrals of ! pressure anomalies across layers, which are required for calculating the ! finite-volume form pressure accelerations in a Boussinesq model. @@ -361,21 +434,48 @@ subroutine int_density_dz_wright(T, S, z_t, z_b, rho_ref, rho_0, G_e, HII, HIO, enddo ; enddo ; endif end subroutine int_density_dz_wright +!> This subroutine calculates analytical and nearly-analytical integrals in +!! pressure across layers of geopotential anomalies, which are required for +!! calculating the finite-volume form pressure accelerations in a non-Boussinesq +!! model. There are essentially no free assumptions, apart from the use of +!! Bode's rule to do the horizontal integrals, and from a truncation in the +!! series for log(1-eps/1+eps) that assumes that |eps| < 0.34. subroutine int_spec_vol_dp_wright(T, S, p_t, p_b, alpha_ref, HI, dza, & intp_dza, intx_dza, inty_dza, halo_size) type(hor_index_type), intent(in) :: HI real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T, S, p_t, p_b - real, intent(in) :: alpha_ref + intent(in) :: T !< Potential temperature relative to the surface + !! in C. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: S !< Salinity in PSU. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(out) :: dza + intent(in) :: p_t !< Pressure at the top of the layer in Pa. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(out) :: intp_dza + intent(in) :: p_b !< Pressure at the top of the layer in Pa. + real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out + !! to reduce the magnitude of each of the integrals, m3 kg-1.The calculation is + !! mathematically identical with different values of alpha_ref, but this reduces the + !! effects of roundoff. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(out) :: dza !< The change in the geopotential anomaly across + !! the layer, in m2 s-2. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + optional, intent(out) :: intp_dza !< The integral in pressure through the layer of + !! the geopotential anomaly relative to the anomaly + !! at the bottom of the layer, in Pa m2 s-2. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & - optional, intent(out) :: intx_dza + optional, intent(out) :: intx_dza !< The integral in x of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the x grid spacing, + !! in m2 s-2. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & - optional, intent(out) :: inty_dza - integer, optional, intent(in) :: halo_size + optional, intent(out) :: inty_dza !< The integral in y of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the y grid spacing, + !! in m2 s-2. + integer, optional, intent(in) :: halo_size !< The width of halo points on which to calculate + !! dza. + ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for ! calculating the finite-volume form pressure accelerations in a non-Boussinesq diff --git a/src/equation_of_state/MOM_EOS_linear.F90 b/src/equation_of_state/MOM_EOS_linear.F90 index cecb0b78ed..bb3acbf56a 100644 --- a/src/equation_of_state/MOM_EOS_linear.F90 +++ b/src/equation_of_state/MOM_EOS_linear.F90 @@ -42,11 +42,21 @@ module MOM_EOS_linear contains +!> This subroutine computes the density of sea water with a trivial +!! linear equation of state (in kg/m^3) from salinity (sal in psu), +!! potential temperature (T in deg C), and pressure in Pa. subroutine calculate_density_scalar_linear(T, S, pressure, rho, & Rho_T0_S0, dRho_dT, dRho_dS) - real, intent(in) :: T, S, pressure - real, intent(out) :: rho - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + real, intent(in) :: T !< Potential temperature relative to the surface in C. + real, intent(in) :: S !< Salinity in PSU. + real, intent(in) :: pressure !< Pressure in Pa. + real, intent(out) :: rho !< In situ density in kg m-3. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT !< The derivatives of density with temperature and salinity, + !! in kg m-3 C-1 and kg m-3 psu-1. + real, intent(in) :: dRho_dS !< The derivatives of density with temperature and salinity, + !! in kg m-3 C-1 and kg m-3 psu-1. + ! * This subroutine computes the density of sea water with a trivial * ! * linear equation of state (in kg/m^3) from salinity (sal in psu), * ! * potential temperature (T in deg C), and pressure in Pa. * @@ -65,12 +75,23 @@ subroutine calculate_density_scalar_linear(T, S, pressure, rho, & end subroutine calculate_density_scalar_linear +!> This subroutine computes the density of sea water with a trivial +!! linear equation of state (in kg/m^3) from salinity (sal in psu), +!! potential temperature (T in deg C), and pressure in Pa. subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & Rho_T0_S0, dRho_dT, dRho_dS) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho - integer, intent(in) :: start, npts - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with + !! temperature and salinity, in kg m-3 C-1 + !! and kg m-3 psu-1. + ! * This subroutine computes the density of sea water with a trivial * ! * linear equation of state (in kg/m^3) from salinity (sal in psu), * ! * potential temperature (T in deg C), and pressure in Pa. * @@ -92,12 +113,25 @@ subroutine calculate_density_array_linear(T, S, pressure, rho, start, npts, & enddo end subroutine calculate_density_array_linear +!> This subroutine calculates the partial derivatives of density * +!! with potential temperature and salinity. subroutine calculate_density_derivs_linear(T, S, pressure, drho_dT_out, & drho_dS_out, start, npts, Rho_T0_S0, dRho_dT, dRho_dS) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: drho_dT_out, drho_dS_out - integer, intent(in) :: start, npts - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: drho_dT_out !< The partial derivative of density with + !! potential temperature, in kg m-3 K-1. + real, intent(out), dimension(:) :: drho_dS_out !< The partial derivative of density with + !! salinity, in kg m-3 psu-1. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with + !! temperature and salinity, in kg m-3 C-1 + !! and kg m-3 psu-1. + ! * This subroutine calculates the partial derivatives of density * ! * with potential temperature and salinity. * ! * * @@ -122,12 +156,24 @@ subroutine calculate_density_derivs_linear(T, S, pressure, drho_dT_out, & end subroutine calculate_density_derivs_linear +! #@# This subroutine needs a doxygen description. subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, & start, npts, Rho_T0_S0, dRho_dT, dRho_dS) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: dSV_dT, dSV_dS - integer, intent(in) :: start, npts - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in g/kg. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: dSV_dS !< The partial derivative of specific volume with + !! salinity, in m3 kg-1 / (g/kg). + real, intent(out), dimension(:) :: dSV_dT !< The partial derivative of specific volume with + !! potential temperature, in m3 kg-1 K-1. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with + !! temperature and salinity, in kg m-3 C-1 + !! and kg m-3 psu-1. + ! * Arguments: T - potential temperature relative to the surface in C. * ! * (in) S - salinity in g/kg. * ! * (in) pressure - pressure in Pa. * @@ -149,12 +195,26 @@ subroutine calculate_specvol_derivs_linear(T, S, pressure, dSV_dT, dSV_dS, & end subroutine calculate_specvol_derivs_linear +!> This subroutine computes the in situ density of sea water (rho) +!! and the compressibility (drho/dp == C_sound^-2) at the given +!! salinity, potential temperature, and pressure. subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& Rho_T0_S0, dRho_dT, dRho_dS) - real, intent(in), dimension(:) :: T, S, pressure - real, intent(out), dimension(:) :: rho, drho_dp - integer, intent(in) :: start, npts - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + real, intent(in), dimension(:) :: T !< Potential temperature relative to the surface + !! in C. + real, intent(in), dimension(:) :: S !< Salinity in PSU. + real, intent(in), dimension(:) :: pressure !< Pressure in Pa. + real, intent(out), dimension(:) :: rho !< In situ density in kg m-3. + real, intent(out), dimension(:) :: drho_dp !< The partial derivative of density with pressure + !! (also the inverse of the square of sound speed) + !! in s2 m-2. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT, dRho_dS !< The derivatives of density with + !! temperature and salinity, in kg m-3 C-1 + !! and kg m-3 psu-1. + ! * This subroutine computes the in situ density of sea water (rho) * ! * and the compressibility (drho/dp == C_sound^-2) at the given * ! * salinity, potential temperature, and pressure. * @@ -180,21 +240,51 @@ subroutine calculate_compress_linear(T, S, pressure, rho, drho_dp, start, npts,& enddo end subroutine calculate_compress_linear +!> This subroutine calculates analytical and nearly-analytical integrals of +!! pressure anomalies across layers, which are required for calculating the +!! finite-volume form pressure accelerations in a Boussinesq model. subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, HIO, & Rho_T0_S0, dRho_dT, dRho_dS, dpa, intz_dpa, intx_dpa, inty_dpa) type(hor_index_type), intent(in) :: HII, HIO real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & - intent(in) :: T, S, z_t, z_b - real, intent(in) :: rho_ref, rho_0_pres, G_e - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + intent(in) :: T !< Potential temperature relative to the surface + !! in C. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: S !< Salinity in PSU. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: z_t !< Height at the top of the layer in m. + real, dimension(HII%isd:HII%ied,HII%jsd:HII%jed), & + intent(in) :: z_b !< Height at the top of the layer in m. + real, intent(in) :: rho_ref !< A mean density, in kg m-3, that is subtracted + !! out to reduce the magnitude of each of the + !! integrals. + real, intent(in) :: rho_0_pres !< A density, in kg m-3, that is used to calculate + !! the pressure (as p~=-z*rho_0_pres*G_e) used in + !! the equation of state. rho_0_pres is not used + !! here. + real, intent(in) :: G_e !< The Earth's gravitational acceleration, + !! in m s-2. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT !< The derivative of density with temperature, + !! in kg m-3 C-1. + real, intent(in) :: dRho_dS !< The derivative of density with salinity, + !! in kg m-3 psu-1. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - intent(out) :: dpa + intent(out) :: dpa !< The change in the pressure anomaly across the + !! layer, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%jsd:HIO%jed), & - optional, intent(out) :: intz_dpa + optional, intent(out) :: intz_dpa !< The integral through the thickness of the layer + !! of the pressure anomaly relative to the anomaly + !! at the top of the layer, in Pa m. real, dimension(HIO%IsdB:HIO%IedB,HIO%jsd:HIO%jed), & - optional, intent(out) :: intx_dpa + optional, intent(out) :: intx_dpa !< The integral in x of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the x grid spacing, in Pa. real, dimension(HIO%isd:HIO%ied,HIO%JsdB:HIO%JedB), & - optional, intent(out) :: inty_dpa + optional, intent(out) :: inty_dpa !< The integral in y of the difference between the + !! pressure anomaly at the top and bottom of the + !! layer divided by the y grid spacing, in Pa. + ! This subroutine calculates analytical and nearly-analytical integrals of ! pressure anomalies across layers, which are required for calculating the ! finite-volume form pressure accelerations in a Boussinesq model. @@ -264,22 +354,50 @@ subroutine int_density_dz_linear(T, S, z_t, z_b, rho_ref, rho_0_pres, G_e, HII, enddo ; enddo ; endif end subroutine int_density_dz_linear +!> This subroutine calculates analytical and nearly-analytical integrals in +!! pressure across layers of geopotential anomalies, which are required for +!! calculating the finite-volume form pressure accelerations in a non-Boussinesq +!! model. Specific volume is assumed to vary linearly between adjacent points. subroutine int_spec_vol_dp_linear(T, S, p_t, p_b, alpha_ref, HI, Rho_T0_S0, & dRho_dT, dRho_dS, dza, intp_dza, intx_dza, inty_dza, halo_size) - type(hor_index_type), intent(in) :: HI + type(hor_index_type), intent(in) :: HI !< The ocean's horizontal index type. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: T !< Potential temperature relative to the surface + !! in C. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(in) :: T, S, p_t, p_b - real, intent(in) :: alpha_ref - real, intent(in) :: Rho_T0_S0, dRho_dT, dRho_dS + intent(in) :: S !< Salinity in PSU. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_t !< Pressure at the top of the layer in Pa. + real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & + intent(in) :: p_b !< Pressure at the top of the layer in Pa. + real, intent(in) :: alpha_ref !< A mean specific volume that is subtracted out + !! to reduce the magnitude of each of the integrals, m3 kg-1. The calculation is + !! mathematically identical with different values of alpha_ref, but this reduces the + !! effects of roundoff. + real, intent(in) :: Rho_T0_S0 !< The density at T=0, S=0, in kg m-3. + real, intent(in) :: dRho_dT !< The derivative of density with temperature, + !! in kg m-3 C-1. + real, intent(in) :: dRho_dS !< The derivative of density with salinity, + !! in kg m-3 psu-1. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - intent(out) :: dza + intent(out) :: dza !< The change in the geopotential anomaly across + !! the layer, in m2 s-2. real, dimension(HI%isd:HI%ied,HI%jsd:HI%jed), & - optional, intent(out) :: intp_dza + optional, intent(out) :: intp_dza !< The integral in pressure through the layer of + !! the geopotential anomaly relative to the anomaly + !! at the bottom of the layer, in Pa m2 s-2. real, dimension(HI%IsdB:HI%IedB,HI%jsd:HI%jed), & - optional, intent(out) :: intx_dza + optional, intent(out) :: intx_dza !< The integral in x of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the x grid spacing, + !! in m2 s-2. real, dimension(HI%isd:HI%ied,HI%JsdB:HI%JedB), & - optional, intent(out) :: inty_dza - integer, optional, intent(in) :: halo_size + optional, intent(out) :: inty_dza !< The integral in y of the difference between the + !! geopotential anomaly at the top and bottom of + !! the layer divided by the y grid spacing, + !! in m2 s-2. + integer, optional, intent(in) :: halo_size + ! This subroutine calculates analytical and nearly-analytical integrals in ! pressure across layers of geopotential anomalies, which are required for ! calculating the finite-volume form pressure accelerations in a non-Boussinesq diff --git a/src/equation_of_state/MOM_TFreeze.F90 b/src/equation_of_state/MOM_TFreeze.F90 index 7893b8e759..7f112ac734 100644 --- a/src/equation_of_state/MOM_TFreeze.F90 +++ b/src/equation_of_state/MOM_TFreeze.F90 @@ -66,12 +66,22 @@ subroutine calculate_TFreeze_linear_scalar(S, pres, T_Fr, TFr_S0_P0, & end subroutine calculate_TFreeze_linear_scalar +!> This subroutine computes the freezing point potential temparature +!! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple +!! linear expression, with coefficients passed in as arguments. subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & TFr_S0_P0, dTFr_dS, dTFr_dp) - real, dimension(:), intent(in) :: S, pres - real, dimension(:), intent(out) :: T_Fr - integer, intent(in) :: start, npts - real, intent(in) :: TFr_S0_P0, dTFr_dS, dTFr_dp + real, dimension(:), intent(in) :: S !< salinity in PSU. + real, dimension(:), intent(in) :: pres !< pressure in Pa. + real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. + real, intent(in) :: TFr_S0_P0 !< The freezing point at S=0, p=0, in deg C. + real, intent(in) :: dTFr_dS !< The derivative of freezing point with salinity, + !! in deg C PSU-1. + real, intent(in) :: dTFr_dp !< The derivative of freezing point with pressure, + !! in deg C Pa-1. + ! This subroutine computes the freezing point potential temparature ! (in deg C) from salinity (in psu), and pressure (in Pa) using a simple ! linear expression, with coefficients passed in as arguments. @@ -94,9 +104,17 @@ subroutine calculate_TFreeze_linear_array(S, pres, T_Fr, start, npts, & end subroutine calculate_TFreeze_linear_array +!> This subroutine computes the freezing point potential temparature +!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression +!! from Millero (1978) (and in appendix A of Gill 1982), but with the of the +!! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an +!! expression for potential temperature (not in situ temperature), using a +!! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) - real, intent(in) :: S, pres - real, intent(out) :: T_Fr + real, intent(in) :: S !< Salinity in PSU. + real, intent(in) :: pres !< Pressure in Pa. + real, intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + ! This subroutine computes the freezing point potential temparature ! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression ! from Millero (1978) (and in appendix A of Gill 1982), but with the of the @@ -114,11 +132,18 @@ subroutine calculate_TFreeze_Millero_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_Millero_scalar - +!> This subroutine computes the freezing point potential temparature +!! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression +!! from Millero (1978) (and in appendix A of Gill 1982), but with the of the +!! pressure dependence changed from 7.53e-8 to 7.75e-8 to make this an +!! expression for potential temperature (not in situ temperature), using a +!! value that is correct at the freezing point at 35 PSU and 5e6 Pa (500 dbar). subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S, pres - real, dimension(:), intent(out) :: T_Fr - integer, intent(in) :: start, npts + real, dimension(:), intent(in) :: S !< Salinity in PSU. + real, dimension(:), intent(in) :: pres !< Pressure in Pa. + real, dimension(:), intent(out) :: T_Fr !< Freezing point potential temperature in deg C. + integer, intent(in) :: start !< The starting point in the arrays. + integer, intent(in) :: npts !< The number of values to calculate. ! This subroutine computes the freezing point potential temparature ! (in deg C) from salinity (in psu), and pressure (in Pa) using the expression ! from Millero (1978) (and in appendix A of Gill 1982), but with the of the @@ -142,9 +167,13 @@ subroutine calculate_TFreeze_Millero_array(S, pres, T_Fr, start, npts) end subroutine calculate_TFreeze_Millero_array +!> This subroutine computes the freezing point conservative temparature +!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the +!! TEOS10 package. subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) - real, intent(in) :: S, pres - real, intent(out) :: T_Fr + real, intent(in) :: S !< Absolute salinity in g/kg. + real, intent(in) :: pres !< Pressure in Pa. + real, intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. ! This subroutine computes the freezing point conservative temparature ! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the ! TEOS10 package. @@ -163,10 +192,15 @@ subroutine calculate_TFreeze_teos10_scalar(S, pres, T_Fr) end subroutine calculate_TFreeze_teos10_scalar +!> This subroutine computes the freezing point conservative temparature +!! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the +!! TEOS10 package. subroutine calculate_TFreeze_teos10_array(S, pres, T_Fr, start, npts) - real, dimension(:), intent(in) :: S, pres - real, dimension(:), intent(out) :: T_Fr - integer, intent(in) :: start, npts + real, dimension(:), intent(in) :: S !< absolute salinity in g/kg. + real, dimension(:), intent(in) :: pres !< pressure in Pa. + real, dimension(:), intent(out) :: T_Fr !< Freezing point conservative temperature in deg C. + integer, intent(in) :: start !< the starting point in the arrays. + integer, intent(in) :: npts !< the number of values to calculate. ! This subroutine computes the freezing point conservative temparature ! (in deg C) from absolute salinity (in g/kg), and pressure (in Pa) using the ! TEOS10 package. diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 4240ded7f4..9467277db2 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -1467,9 +1467,9 @@ subroutine MOM_checksums_init(param_file) type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_checksums" ! This module's name. + character(len=40) :: mdl = "MOM_checksums" ! This module's name. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) end subroutine MOM_checksums_init diff --git a/src/framework/MOM_document.F90 b/src/framework/MOM_document.F90 index ca058089e1..648abd81dd 100644 --- a/src/framework/MOM_document.F90 +++ b/src/framework/MOM_document.F90 @@ -373,11 +373,12 @@ subroutine doc_closeBlock(doc, blockName) endif end subroutine doc_closeBlock -subroutine doc_param_time(doc, varname, desc, units, val, default) +subroutine doc_param_time(doc, varname, desc, units, val, default, layoutParam) type(doc_type), pointer :: doc character(len=*), intent(in) :: varname, desc, units type(time_type), intent(in) :: val type(time_type), optional, intent(in) :: default + logical, optional, intent(in) :: layoutParam ! This subroutine handles parameter documentation for time-type variables. ! ### This needs to be written properly! integer :: numspc @@ -394,7 +395,7 @@ subroutine doc_param_time(doc, varname, desc, units, val, default) if (len_trim(units) > 0) mesg = trim(mesg)//" ["//trim(units)//"]" if (mesgHasBeenDocumented(doc, varName, mesg)) return ! Avoid duplicates - call writeMessageAndDesc(doc, mesg, desc, equalsDefault) + call writeMessageAndDesc(doc, mesg, desc, equalsDefault, layoutParam=layoutParam) endif end subroutine doc_param_time diff --git a/src/framework/MOM_domains.F90 b/src/framework/MOM_domains.F90 index 5e872d0a72..d9d6660132 100644 --- a/src/framework/MOM_domains.F90 +++ b/src/framework/MOM_domains.F90 @@ -139,13 +139,26 @@ module MOM_domains contains +! #@# This subroutine needs a doxygen description subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo) - real, dimension(:,:,:), intent(inout) :: array - type(MOM_domain_type), intent(inout) :: MOM_dom - integer, optional, intent(in) :: sideflag - logical, optional, intent(in) :: complete - integer, optional, intent(in) :: position - integer, optional, intent(in) :: halo + real, dimension(:,:,:), intent(inout) :: array !< The array which is having its halos points + !! exchanged. + type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain + !! needed to determine where data should be + !! sent. + integer, optional, intent(in) :: sideflag !< An optional integer indicating which + !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST, + !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east, + !! sothe halos on the western side are filled. TO_ALL is the default if sideflag is omitted. + logical, optional, intent(in) :: complete !< An optional argument indicating whether the + !! halo updates should be completed before + !! progress resumes. Omitting complete is the + !! same as setting complete to .true. + integer, optional, intent(in) :: position !< An optional argument indicating the position. + !! This is usally CORNER, but is CENTER by + !! default. + integer, optional, intent(in) :: halo !< The size of the halo to update - the full + !! halo by default. ! Arguments: array - The array which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. @@ -180,14 +193,25 @@ subroutine pass_var_3d(array, MOM_dom, sideflag, complete, position, halo) end subroutine pass_var_3d - +! #@# This subroutine needs a doxygen description subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo) - real, dimension(:,:), intent(inout) :: array - type(MOM_domain_type), intent(inout) :: MOM_dom - integer, optional, intent(in) :: sideflag - logical, optional, intent(in) :: complete - integer, optional, intent(in) :: position - integer, optional, intent(in) :: halo + real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points + !! exchanged. + type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain + !! needed to determine where data should be sent. + integer, optional, intent(in) :: sideflag !< An optional integer indicating which + !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST, + !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east, + !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted. + logical, optional, intent(in) :: complete !< An optional argument indicating whether the + !! halo updates should be completed before + !! progress resumes. Omitting complete is the + !! same as setting complete to .true. + integer, optional, intent(in) :: position !< An optional argument indicating the position. + !! This is usally CORNER, but is CENTER + !! by default. + integer, optional, intent(in) :: halo !< The size of the halo to update - the full halo + !! by default. ! Arguments: array - The array which is having its halos points exchanged. ! (in) MOM_dom - The MOM_domain_type containing the mpp_domain needed to ! determine where data should be sent. @@ -224,13 +248,25 @@ subroutine pass_var_2d(array, MOM_dom, sideflag, complete, position, halo) end subroutine pass_var_2d function pass_var_start_2d(array, MOM_dom, sideflag, position, complete, halo) - real, dimension(:,:), intent(inout) :: array - type(MOM_domain_type), intent(inout) :: MOM_dom - integer, optional, intent(in) :: sideflag - integer, optional, intent(in) :: position - logical, optional, intent(in) :: complete - integer, optional, intent(in) :: halo - integer :: pass_var_start_2d + real, dimension(:,:), intent(inout) :: array !< The array which is having its halos points + !! exchanged. + type(MOM_domain_type), intent(inout) :: MOM_dom !< The MOM_domain_type containing the mpp_domain + !! needed to determine where data should be + !! sent. + integer, optional, intent(in) :: sideflag !< An optional integer indicating which + !! directions the data should be sent. It is TO_ALL or the sum of any of TO_EAST, TO_WEST, + !! TO_NORTH, and TO_SOUTH. For example, TO_EAST sends the data to the processor to the east, + !! so the halos on the western side are filled. TO_ALL is the default if sideflag is omitted. + integer, optional, intent(in) :: position !< An optional argument indicating the position. + !! This is usally CORNER, but is CENTER + !! by default. + logical, optional, intent(in) :: complete !< An optional argument indicating whether the + !! halo updates should be completed before + !! progress resumes. Omitting complete is the + !! same as setting complete to .true. + integer, optional, intent(in) :: halo !< The size of the halo to update - the full + !! halo by default. + integer :: pass_var_start_2d ! 0) then - call log_param(CS, mod, "COMPLETE_DOCUMENTATION", & + call log_param(CS, mdl, "COMPLETE_DOCUMENTATION", & CS%complete_doc, & "If true, all run-time parameters are\n"//& "documented in "//trim(CS%doc_file)//& ".all .", default=complete_doc_default) - call log_param(CS, mod, "MINIMAL_DOCUMENTATION", & + call log_param(CS, mdl, "MINIMAL_DOCUMENTATION", & CS%minimal_doc, & "If true, non-default run-time parameters are\n"//& "documented in "//trim(CS%doc_file)//& @@ -781,30 +782,60 @@ subroutine read_param_logical(CS, varname, value, fail_if_missing) end subroutine read_param_logical -subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing) +subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: varname type(time_type), intent(inout) :: value real, optional, intent(in) :: timeunit logical, optional, intent(in) :: fail_if_missing -! This subroutine determines the value of an integer model parameter + logical, optional, intent(out) :: date_format +! This subroutine determines the value of an time-type model parameter ! from a parameter file. The arguments are the unit of the open file ! which is to be read, the (case-sensitive) variable name, the variable ! where the value is to be stored, and (optionally) a flag indicating ! whether to fail if this parameter can not be found. The unique argument ! to read time is the number of seconds to use as the unit of time being read. character(len=INPUT_STR_LENGTH) :: value_string(1) + character(len=240) :: err_msg logical :: found, defined real :: real_time, time_unit - integer :: days, secs + integer :: days, secs, vals(7) + + if (present(date_format)) date_format = .false. call get_variable_line(CS, varname, found, defined, value_string) if (found .and. defined .and. (LEN_TRIM(value_string(1)) > 0)) then - time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit - read( value_string(1), *) real_time - days = int(real_time*(time_unit/86400.0)) - secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) - value = set_time(secs, days) + ! Determine whether value string should be parsed for a real number + ! or a date, in either a string format or a comma-delimited list of values. + if ((INDEX(value_string(1),'-') > 0) .and. & + (INDEX(value_string(1),'-',back=.true.) > INDEX(value_string(1),'-'))) then + ! There are two dashes, so this must be a date format. + value = set_date(value_string(1), err_msg=err_msg) + if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//& + trim(err_msg)//' in integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + if (present(date_format)) date_format = .true. + elseif (INDEX(value_string(1),',') > 0) then + ! Initialize vals with an invalid date. + vals(:) = (/ -999, -999, -999, 0, 0, 0, 0 /) + read(value_string(1),*,end=995,err=1005) vals + 995 continue + if ((vals(1) < 0) .or. (vals(2) < 0) .or. (vals(3) < 0)) & + call MOM_error(FATAL,'read_param_time: integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + value = set_date(vals(1), vals(2), vals(3), vals(4), vals(5), vals(6), & + vals(7), err_msg=err_msg) + if (LEN_TRIM(err_msg) > 0) call MOM_error(FATAL,'read_param_time: '//& + trim(err_msg)//' in integer list read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') + if (present(date_format)) date_format = .true. + else + time_unit = 1.0 ; if (present(timeunit)) time_unit = timeunit + read( value_string(1), *) real_time + days = int(real_time*(time_unit/86400.0)) + secs = int(floor((real_time*(time_unit/86400.0)-days)*86400.0 + 0.5)) + value = set_time(secs, days) + endif else if (present(fail_if_missing)) then ; if (fail_if_missing) then if (.not.found) then @@ -816,6 +847,9 @@ subroutine read_param_time(CS, varname, value, timeunit, fail_if_missing) endif endif ; endif endif + return + 1005 call MOM_error(FATAL,'read_param_time: read error for time-type variable '//& + trim(varname)// ' parsing "'//trim(value_string(1))//'"') end subroutine read_param_time function strip_quotes(val_str) @@ -1382,8 +1416,10 @@ subroutine log_param_char(CS, modulename, varname, value, desc, units, & end subroutine log_param_char +!> This subroutine writes the value of a time-type parameter to a log file, +!! along with its name and the module it came from. subroutine log_param_time(CS, modulename, varname, value, desc, units, & - default, timeunit) + default, timeunit, layoutParam, log_date) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: modulename character(len=*), intent(in) :: varname @@ -1391,12 +1427,17 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & character(len=*), optional, intent(in) :: desc, units type(time_type), optional, intent(in) :: default real, optional, intent(in) :: timeunit -! This subroutine writes the value of a time-type parameter to a log file, -! along with its name and the module it came from. + logical, optional, intent(in) :: log_date !< If true, log the time_type in date format. + logical, optional, intent(in) :: layoutParam + real :: real_time, real_default - logical :: use_timeunit = .false. + logical :: use_timeunit, date_format character(len=240) :: mesg, myunits - integer :: days, secs, ticks + character(len=80) :: date_string, default_string + integer :: days, secs, ticks, ticks_per_sec + + use_timeunit = .false. + date_format = .false. ; if (present(log_date)) date_format = log_date call get_time(value, secs, days, ticks) @@ -1414,7 +1455,19 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & if (present(desc)) then if (present(timeunit)) use_timeunit = (timeunit > 0.0) - if (use_timeunit) then + if (date_format) then + myunits='[date]' + + date_string = convert_date_to_string(value) + if (present(default)) then + default_string = convert_date_to_string(default) + call doc_param(CS%doc, varname, desc, myunits, date_string, & + default=default_string, layoutParam=layoutParam) + else + call doc_param(CS%doc, varname, desc, myunits, date_string, & + layoutParam=layoutParam) + endif + elseif (use_timeunit) then if (present(units)) then write(myunits(1:240),'(A)') trim(units) else @@ -1444,6 +1497,34 @@ subroutine log_param_time(CS, modulename, varname, value, desc, units, & end subroutine log_param_time +!> This function converts a date into a string, valid with ticks and for dates up to year 99,999,999 +function convert_date_to_string(date) result(date_string) + type(time_type), intent(in) :: date !< The date to be translated into a string. + character(len=40) :: date_string !< A date string in a format like YYYY-MM-DD HH:MM:SS.sss + + character(len=40) :: sub_string + real :: real_secs + integer :: yrs, mons, days, hours, mins, secs, ticks, ticks_per_sec + + call get_date(date, yrs, mons, days, hours, mins, secs, ticks) + write (date_string, '(i8.4)') yrs + write (sub_string, '("-", i2.2, "-", I2.2, " ", i2.2, ":", i2.2, ":")') & + mons, days, hours, mins + date_string = trim(adjustl(date_string)) // trim(sub_string) + if (ticks > 0) then + ticks_per_sec = get_ticks_per_second() + real_secs = secs + ticks/ticks_per_sec + if (ticks_per_sec <= 100) then + write (sub_string, '(F7.3)') real_secs + else + write (sub_string, '(F10.6)') real_secs + endif + else + write (sub_string, '(i2.2)') secs + endif + date_string = trim(date_string) // trim(adjustl(sub_string)) + +end function convert_date_to_string subroutine get_param_int(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & @@ -1675,7 +1756,7 @@ end subroutine get_param_logical subroutine get_param_time(CS, modulename, varname, value, desc, units, & default, fail_if_missing, do_not_read, do_not_log, & - timeunit, static_value) + timeunit, static_value, layoutParam, log_as_date) type(param_file_type), intent(in) :: CS character(len=*), intent(in) :: modulename character(len=*), intent(in) :: varname @@ -1685,22 +1766,26 @@ subroutine get_param_time(CS, modulename, varname, value, desc, units, & logical, optional, intent(in) :: fail_if_missing logical, optional, intent(in) :: do_not_read, do_not_log real, optional, intent(in) :: timeunit + logical, optional, intent(in) :: layoutParam + logical, optional, intent(in) :: log_as_date ! This subroutine writes the value of a real parameter to a log file, ! along with its name and the module it came from. - logical :: do_read, do_log + logical :: do_read, do_log, date_format, log_date do_read = .true. ; if (present(do_not_read)) do_read = .not.do_not_read do_log = .true. ; if (present(do_not_log)) do_log = .not.do_not_log + log_date = .false. if (do_read) then if (present(default)) value = default if (present(static_value)) value = static_value - call read_param_time(CS, varname, value, timeunit, fail_if_missing) + call read_param_time(CS, varname, value, timeunit, fail_if_missing, date_format=log_date) endif if (do_log) then - call log_param_time(CS, modulename, varname, value, desc, & - units, default, timeunit) + if (present(log_as_date)) log_date = log_as_date + call log_param_time(CS, modulename, varname, value, desc, units, default, & + timeunit, layoutParam=layoutParam, log_date=log_date) endif end subroutine get_param_time diff --git a/src/framework/MOM_io.F90 b/src/framework/MOM_io.F90 index 5c46a13062..d66135b2cc 100644 --- a/src/framework/MOM_io.F90 +++ b/src/framework/MOM_io.F90 @@ -842,9 +842,9 @@ subroutine MOM_io_init(param_file) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_io" ! This module's name. + character(len=40) :: mdl = "MOM_io" ! This module's name. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) end subroutine MOM_io_init diff --git a/src/framework/MOM_restart.F90 b/src/framework/MOM_restart.F90 index 794d321039..56d03c8b42 100644 --- a/src/framework/MOM_restart.F90 +++ b/src/framework/MOM_restart.F90 @@ -1257,7 +1257,7 @@ subroutine restart_init(param_file, CS, restart_root) ! module by other components. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_restart" ! This module's name. + character(len=40) :: mdl = "MOM_restart" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "restart_init called with an associated control structure.") @@ -1266,8 +1266,8 @@ subroutine restart_init(param_file, CS, restart_root) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "PARALLEL_RESTARTFILES", & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", & CS%parallel_restartfiles, & "If true, each processor writes its own restart file, \n"//& "otherwise a single restart file is generated", & @@ -1275,16 +1275,16 @@ subroutine restart_init(param_file, CS, restart_root) if (present(restart_root)) then CS%restartfile = restart_root - call log_param(param_file, mod, "RESTARTFILE from argument", CS%restartfile) + call log_param(param_file, mdl, "RESTARTFILE from argument", CS%restartfile) else - call get_param(param_file, mod, "RESTARTFILE", CS%restartfile, & + call get_param(param_file, mdl, "RESTARTFILE", CS%restartfile, & "The name-root of the restart file.", default="MOM.res") endif - call get_param(param_file, mod, "LARGE_FILE_SUPPORT", CS%large_file_support, & + call get_param(param_file, mdl, "LARGE_FILE_SUPPORT", CS%large_file_support, & "If true, use the file-size limits with NetCDF large \n"//& "file support (4Gb), otherwise the limit is 2Gb.", & default=.true.) - call get_param(param_file, mod, "MAX_FIELDS", CS%max_fields, & + call get_param(param_file, mdl, "MAX_FIELDS", CS%max_fields, & "The maximum number of restart fields that can be used.", & default=100) diff --git a/src/framework/MOM_time_manager.F90 b/src/framework/MOM_time_manager.F90 index 9926318772..98ae835272 100644 --- a/src/framework/MOM_time_manager.F90 +++ b/src/framework/MOM_time_manager.F90 @@ -18,7 +18,8 @@ module MOM_time_manager use time_manager_mod, only : get_date, set_date, increment_date use time_manager_mod, only : days_in_month, month_name use time_manager_mod, only : set_calendar_type, get_calendar_type -use time_manager_mod, only : JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +use time_manager_mod, only : JULIAN, NOLEAP, THIRTY_DAY_MONTHS, GREGORIAN +use time_manager_mod, only : NO_CALENDAR implicit none ; private @@ -28,7 +29,7 @@ module MOM_time_manager public :: operator(>), operator(<), operator(>=), operator(<=) public :: operator(==), operator(/=), operator(//) public :: get_date, set_date, increment_date, month_name, days_in_month -public :: JULIAN, NOLEAP, THIRTY_DAY_MONTHS, NO_CALENDAR +public :: JULIAN, NOLEAP, THIRTY_DAY_MONTHS, GREGORIAN, NO_CALENDAR public :: set_calendar_type, get_calendar_type end module MOM_time_manager diff --git a/src/framework/MOM_write_cputime.F90 b/src/framework/MOM_write_cputime.F90 index ad2a1b2f41..3af557f6ab 100644 --- a/src/framework/MOM_write_cputime.F90 +++ b/src/framework/MOM_write_cputime.F90 @@ -91,7 +91,7 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) integer :: new_cputime ! The CPU time returned by SYSTEM_CLOCK ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = 'MOM_write_cputime' ! This module's name. + character(len=40) :: mdl = 'MOM_write_cputime' ! This module's name. if (.not.associated(CS)) then allocate(CS) @@ -100,8 +100,8 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MAXCPU", CS%maxcpu, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MAXCPU", CS%maxcpu, & "The maximum amount of cpu time per processor for which \n"//& "MOM should run before saving a restart file and \n"//& "quitting with a return value that indicates that a \n"//& @@ -111,10 +111,10 @@ subroutine MOM_write_cputime_init(param_file, directory, Input_start_time, CS) "seconds, so the actual CPU time used is larger by a \n"//& "factor of the number of processors used.", & units="wall-clock seconds", default=-1.0) - call get_param(param_file, mod, "CPU_TIME_FILE", CS%CPUfile, & + call get_param(param_file, mdl, "CPU_TIME_FILE", CS%CPUfile, & "The file into which CPU time is written.",default="CPU_stats") CS%CPUfile = trim(directory)//trim(CS%CPUfile) - call log_param(param_file, mod, "directory/CPU_TIME_FILE", CS%CPUfile) + call log_param(param_file, mdl, "directory/CPU_TIME_FILE", CS%CPUfile) #ifdef STATSLABEL CS%CPUfile = trim(CS%CPUfile)//"."//trim(adjustl(STATSLABEL)) #endif diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index 1294ed065b..2069a347a7 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1197,7 +1197,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti character(len=200) :: config character(len=200) :: IC_file,filename,inputdir character(len=40) :: var_name - character(len=40) :: mod = "MOM_ice_shelf" ! This module's name. + character(len=40) :: mdl = "MOM_ice_shelf" ! This module's name. character(len=2) :: procnum integer :: i, j, is, ie, js, je, isd, ied, jsd, jed, Isdq, Iedq, Jsdq, Jedq, iters integer :: wd_halos(2) @@ -1262,42 +1262,42 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti CS%use_reproducing_sums = .false. CS%switch_var = .false. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DEBUG_IS", CS%debug, default=.false.) - call get_param(param_file, mod, "DYNAMIC_SHELF_MASS", CS%shelf_mass_is_dynamic, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DEBUG_IS", CS%debug, default=.false.) + call get_param(param_file, mdl, "DYNAMIC_SHELF_MASS", CS%shelf_mass_is_dynamic, & "If true, the ice sheet mass can evolve with time.", & default=.false.) if (CS%shelf_mass_is_dynamic) then - call get_param(param_file, mod, "OVERRIDE_SHELF_MOVEMENT", CS%override_shelf_movement, & + call get_param(param_file, mdl, "OVERRIDE_SHELF_MOVEMENT", CS%override_shelf_movement, & "If true, user provided code specifies the ice-shelf \n"//& "movement instead of the dynamic ice model.", default=.false.) - call get_param(param_file, mod, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & + call get_param(param_file, mdl, "GROUNDING_LINE_INTERPOLATE", CS%GL_regularize, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) - call get_param(param_file, mod, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & + call get_param(param_file, mdl, "GROUNDING_LINE_INTERP_SUBGRID_N", CS%n_sub_regularize, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=0) - call get_param(param_file, mod, "GROUNDING_LINE_COUPLE", CS%GL_couple, & + call get_param(param_file, mdl, "GROUNDING_LINE_COUPLE", CS%GL_couple, & "THIS PARAMETER NEEDS A DESCRIPTION.", default=.false.) if (CS%GL_regularize) CS%GL_couple = .false. if (CS%GL_regularize .and. (CS%n_sub_regularize.eq.0)) call MOM_error (FATAL, & "GROUNDING_LINE_INTERP_SUBGRID_N must be a positive integer if GL regularization is used") endif - call get_param(param_file, mod, "SHELF_THERMO", CS%isthermo, & + call get_param(param_file, mdl, "SHELF_THERMO", CS%isthermo, & "If true, use a thermodynamically interactive ice shelf.", & default=.false.) - call get_param(param_file, mod, "SHELF_THREE_EQN", CS%threeeq, & + call get_param(param_file, mdl, "SHELF_THREE_EQN", CS%threeeq, & "If true, use the three equation expression of \n"//& "consistency to calculate the fluxes at the ice-ocean \n"//& "interface.", default=.true.) - call get_param(param_file, mod, "SHELF_INSULATOR", CS%insulator, & + call get_param(param_file, mdl, "SHELF_INSULATOR", CS%insulator, & "If true, the ice shelf is a perfect insulatior \n"//& "(no conduction).", default=.false.) - call get_param(param_file, mod, "MELTING_CUTOFF_DEPTH", CS%cutoff_depth, & + call get_param(param_file, mdl, "MELTING_CUTOFF_DEPTH", CS%cutoff_depth, & "Depth above which the melt is set to zero (it must be >= 0) \n"//& "Default value won't affect the solution.", default=0.0) if (CS%cutoff_depth < 0.) & call MOM_error(WARNING,"Initialize_ice_shelf: MELTING_CUTOFF_DEPTH must be >= 0.") - call get_param(param_file, mod, "CONST_SEA_LEVEL", CS%constant_sea_level, & + call get_param(param_file, mdl, "CONST_SEA_LEVEL", CS%constant_sea_level, & "If true, apply evaporative, heat and salt fluxes in \n"//& "the sponge region. This will avoid a large increase \n"//& "in sea level. This option is needed for some of the \n"//& @@ -1305,40 +1305,40 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti "IMPORTANT: it is not currently possible to do \n"//& "prefect restarts using this flag.", default=.false.) - call get_param(param_file, mod, "ISOMIP_S_SUR_SPONGE", & + call get_param(param_file, mdl, "ISOMIP_S_SUR_SPONGE", & CS%S0, "Surface salinity in the resoring region.", & default=33.8, do_not_log=.true.) - call get_param(param_file, mod, "ISOMIP_T_SUR_SPONGE", & + call get_param(param_file, mdl, "ISOMIP_T_SUR_SPONGE", & CS%T0, "Surface temperature in the resoring region.", & default=-1.9, do_not_log=.true.) - call get_param(param_file, mod, "SHELF_3EQ_GAMMA", CS%const_gamma, & + call get_param(param_file, mdl, "SHELF_3EQ_GAMMA", CS%const_gamma, & "If true, user specifies a constant nondimensional heat-transfer coefficient \n"//& "(GAMMA_T_3EQ), from which the salt-transfer coefficient is then computed \n"//& " as GAMMA_T_3EQ/35. This is used with SHELF_THREE_EQN.", default=.false.) - if (CS%const_gamma) call get_param(param_file, mod, "SHELF_3EQ_GAMMA_T", CS%Gamma_T_3EQ, & + if (CS%const_gamma) call get_param(param_file, mdl, "SHELF_3EQ_GAMMA_T", CS%Gamma_T_3EQ, & "Nondimensional heat-transfer coefficient.",default=2.2E-2, & units="nondim.", fail_if_missing=.true.) - call get_param(param_file, mod, "ICE_SHELF_MASS_FROM_FILE", & + call get_param(param_file, mdl, "ICE_SHELF_MASS_FROM_FILE", & CS%mass_from_file, "Read the mass of the & ice shelf (every time step) from a file.", default=.false.) if (CS%threeeq) & - call get_param(param_file, mod, "SHELF_S_ROOT", CS%find_salt_root, & + call get_param(param_file, mdl, "SHELF_S_ROOT", CS%find_salt_root, & "If SHELF_S_ROOT = True, salinity at the ice/ocean interface (Sbdry) \n "//& "is computed from a quadratic equation. Otherwise, the previous \n"//& "interactive method to estimate Sbdry is used.", default=.false.) if (CS%find_salt_root) then ! read liquidus coeffs. - call get_param(param_file, mod, "TFREEZE_S0_P0",CS%lambda1, & + call get_param(param_file, mdl, "TFREEZE_S0_P0",CS%lambda1, & "this is the freezing potential temperature at \n"//& "S=0, P=0.", units="deg C", default=0.0, do_not_log=.true.) - call get_param(param_file, mod, "DTFREEZE_DS",CS%lambda1, & + call get_param(param_file, mdl, "DTFREEZE_DS",CS%lambda1, & "this is the derivative of the freezing potential \n"//& "temperature with salinity.", & units="deg C PSU-1", default=-0.054, do_not_log=.true.) - call get_param(param_file, mod, "DTFREEZE_DP",CS%lambda3, & + call get_param(param_file, mdl, "DTFREEZE_DP",CS%lambda3, & "this is the derivative of the freezing potential \n"//& "temperature with pressure.", & units="deg C Pa-1", default=0.0, do_not_log=.true.) @@ -1346,79 +1346,79 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti endif if (.not.CS%threeeq) & - call get_param(param_file, mod, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & + call get_param(param_file, mdl, "SHELF_2EQ_GAMMA_T", CS%gamma_t, & "If SHELF_THREE_EQN is false, this the fixed turbulent \n"//& "exchange velocity at the ice-ocean interface.", & units="m s-1", fail_if_missing=.true.) - call get_param(param_file, mod, "G_EARTH", CS%g_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%g_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "C_P", CS%Cp, & + call get_param(param_file, mdl, "C_P", CS%Cp, & "The heat capacity of sea water.", units="J kg-1 K-1", & fail_if_missing=.true.) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) !### MAKE THIS A SEPARATE PARAMETER. - call get_param(param_file, mod, "C_P_ICE", CS%Cp_ice, & + call get_param(param_file, mdl, "C_P_ICE", CS%Cp_ice, & "The heat capacity of ice.", units="J kg-1 K-1", & default=2.10e3) - call get_param(param_file, mod, "ICE_SHELF_FLUX_FACTOR", CS%flux_factor, & + call get_param(param_file, mdl, "ICE_SHELF_FLUX_FACTOR", CS%flux_factor, & "Non-dimensional factor applied to shelf thermodynamic \n"//& "fluxes.", units="none", default=1.0) - call get_param(param_file, mod, "KV_ICE", CS%kv_ice, & + call get_param(param_file, mdl, "KV_ICE", CS%kv_ice, & "The viscosity of the ice.", units="m2 s-1", default=1.0e10) - call get_param(param_file, mod, "KV_MOLECULAR", CS%kv_molec, & + call get_param(param_file, mdl, "KV_MOLECULAR", CS%kv_molec, & "The molecular kinimatic viscosity of sea water at the \n"//& "freezing temperature.", units="m2 s-1", default=1.95e-6) - call get_param(param_file, mod, "ICE_SHELF_SALINITY", CS%Salin_ice, & + call get_param(param_file, mdl, "ICE_SHELF_SALINITY", CS%Salin_ice, & "The salinity of the ice inside the ice shelf.", units="PSU", & default=0.0) - call get_param(param_file, mod, "ICE_SHELF_TEMPERATURE", CS%Temp_ice, & + call get_param(param_file, mdl, "ICE_SHELF_TEMPERATURE", CS%Temp_ice, & "The temperature at the center of the ice shelf.", & units = "degC", default=-15.0) - call get_param(param_file, mod, "KD_SALT_MOLECULAR", CS%kd_molec_salt, & + call get_param(param_file, mdl, "KD_SALT_MOLECULAR", CS%kd_molec_salt, & "The molecular diffusivity of salt in sea water at the \n"//& "freezing point.", units="m2 s-1", default=8.02e-10) - call get_param(param_file, mod, "KD_TEMP_MOLECULAR", CS%kd_molec_temp, & + call get_param(param_file, mdl, "KD_TEMP_MOLECULAR", CS%kd_molec_temp, & "The molecular diffusivity of heat in sea water at the \n"//& "freezing point.", units="m2 s-1", default=1.41e-7) - call get_param(param_file, mod, "RHO_0", CS%density_ocean_avg, & + call get_param(param_file, mdl, "RHO_0", CS%density_ocean_avg, & "avg ocean density used in floatation cond", & units="kg m-3", default=1035.) - call get_param(param_file, mod, "DT_FORCING", CS%time_step, & + call get_param(param_file, mdl, "DT_FORCING", CS%time_step, & "The time step for changing forcing, coupling with other \n"//& "components, or potentially writing certain diagnostics. \n"//& "The default value is given by DT.", units="s", default=0.0) - call get_param(param_file, mod, "SHELF_DIAG_TIMESTEP", CS%velocity_update_time_step, & + call get_param(param_file, mdl, "SHELF_DIAG_TIMESTEP", CS%velocity_update_time_step, & "A timestep to use for diagnostics of the shelf.", default=0.0) - call get_param(param_file, mod, "COL_THICK_MELT_THRESHOLD", CS%col_thick_melt_threshold, & + call get_param(param_file, mdl, "COL_THICK_MELT_THRESHOLD", CS%col_thick_melt_threshold, & "The minimum ML thickness where melting is allowed.", units="m", & default=0.0) - call get_param(param_file, mod, "READ_TIDEAMP", read_TIDEAMP, & + call get_param(param_file, mdl, "READ_TIDEAMP", read_TIDEAMP, & "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) call safe_alloc_ptr(CS%utide,isd,ied,jsd,jed) ; CS%utide(:,:) = 0.0 if (read_TIDEAMP) then - call get_param(param_file, mod, "TIDEAMP_FILE", TideAmp_file, & + call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes.", & default="tideamp.nc") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) TideAmp_file = trim(inputdir) // trim(TideAmp_file) call read_data(TideAmp_file,'tideamp',CS%utide,domain=G%domain%mpp_domain,timelevel=1) else - call get_param(param_file, mod, "UTIDE", utide, & + call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0) CS%utide = utide @@ -1430,54 +1430,54 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti if (CS%shelf_mass_is_dynamic .and. .not.CS%override_shelf_movement) then - call get_param(param_file, mod, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & + call get_param(param_file, mdl, "A_GLEN_ISOTHERM", CS%A_glen_isothermal, & "Ice viscosity parameter in Glen's Law", & units="Pa -1/3 a", default=9.461e-18) - call get_param(param_file, mod, "GLEN_EXPONENT", CS%n_glen, & + call get_param(param_file, mdl, "GLEN_EXPONENT", CS%n_glen, & "nonlinearity exponent in Glen's Law", & units="none", default=3.) - call get_param(param_file, mod, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & + call get_param(param_file, mdl, "MIN_STRAIN_RATE_GLEN", CS%eps_glen_min, & "min. strain rate to avoid infinite Glen's law viscosity", & units="a-1", default=1.e-12) - call get_param(param_file, mod, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & + call get_param(param_file, mdl, "BASAL_FRICTION_COEFF", CS%C_basal_friction, & "ceofficient in sliding law \tau_b = C u^(n_basal_friction)", & units="Pa (m-a)-(n_basal_friction)", fail_if_missing=.true.) - call get_param(param_file, mod, "BASAL_FRICTION_EXP", CS%n_basal_friction, & + call get_param(param_file, mdl, "BASAL_FRICTION_EXP", CS%n_basal_friction, & "exponent in sliding law \tau_b = C u^(m_slide)", & units="none", fail_if_missing=.true.) - call get_param(param_file, mod, "DENSITY_ICE", CS%density_ice, & + call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=917.0) - call get_param(param_file, mod, "INPUT_FLUX_ICE_SHELF", CS%input_flux, & + call get_param(param_file, mdl, "INPUT_FLUX_ICE_SHELF", CS%input_flux, & "volume flux at upstream boundary", & units="m2 s-1", default=0.) - call get_param(param_file, mod, "INPUT_THICK_ICE_SHELF", CS%input_thickness, & + call get_param(param_file, mdl, "INPUT_THICK_ICE_SHELF", CS%input_thickness, & "flux thickness at upstream boundary", & units="m", default=1000.) - call get_param(param_file, mod, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & + call get_param(param_file, mdl, "ICE_VELOCITY_TIMESTEP", CS%velocity_update_time_step, & "seconds between ice velocity calcs", units="s", & fail_if_missing=.true.) - call get_param(param_file, mod, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_TOLERANCE", CS%cg_tolerance, & "tolerance in CG solver, relative to initial residual", default=1.e-6) - call get_param(param_file, mod, "ICE_NONLINEAR_TOLERANCE", & + call get_param(param_file, mdl, "ICE_NONLINEAR_TOLERANCE", & CS%nonlinear_tolerance,"nonlin tolerance in iterative velocity solve",default=1.e-6) - call get_param(param_file, mod, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & + call get_param(param_file, mdl, "CONJUGATE_GRADIENT_MAXIT", CS%cg_max_iterations, & "max iteratiions in CG solver", default=2000) - call get_param(param_file, mod, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & + call get_param(param_file, mdl, "THRESH_FLOAT_COL_DEPTH", CS%thresh_float_col_depth, & "min ocean thickness to consider ice *floating*; \n"// & "will only be important with use of tides", & units="m",default=1.e-3) - call get_param(param_file, mod, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & + call get_param(param_file, mdl, "SHELF_MOVING_FRONT", CS%moving_shelf_front, & "whether or not to advance shelf front (and calve..)") - call get_param(param_file, mod, "CALVE_TO_MASK", CS%calve_to_mask, & + call get_param(param_file, mdl, "CALVE_TO_MASK", CS%calve_to_mask, & "if true, do not allow an ice shelf where prohibited by a mask") - call get_param(param_file, mod, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & + call get_param(param_file, mdl, "ICE_SHELF_CFL_FACTOR", CS%CFL_factor, & "limit timestep as a factor of min (\Delta x / u); \n"// & "only important for ice-only model", & default=0.25) - call get_param(param_file, mod, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & + call get_param(param_file, mdl, "NONLIN_SOLVE_ERR_MODE", CS%nonlin_solve_err_mode, & "choose whether nonlin error in vel solve is based on nonlinear residual (1) \n"// & "or relative change since last iteration (2)", & default=1) @@ -1491,28 +1491,28 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti else CS%nstep_velocity = 0 ! This is here because of inconsistent defaults. I don't know why. RWH - call get_param(param_file, mod, "DENSITY_ICE", CS%density_ice, & + call get_param(param_file, mdl, "DENSITY_ICE", CS%density_ice, & "A typical density of ice.", units="kg m-3", default=900.0) endif - call get_param(param_file, mod, "MIN_THICKNESS_SIMPLE_CALVE", & + call get_param(param_file, mdl, "MIN_THICKNESS_SIMPLE_CALVE", & CS%min_thickness_simple_calve, & "min thickness rule for VERY simple calving law",& units="m", default=0.0) - call get_param(param_file, mod, "WRITE_OUTPUT_TO_FILE", & + call get_param(param_file, mdl, "WRITE_OUTPUT_TO_FILE", & CS%write_output_to_file, "for debugging purposes",default=.false.) - call get_param(param_file, mod, "USTAR_SHELF_BG", CS%ustar_bg, & + call get_param(param_file, mdl, "USTAR_SHELF_BG", CS%ustar_bg, & "The minimum value of ustar under ice sheves.", units="m s-1", & default=0.0) - call get_param(param_file, mod, "CDRAG_SHELF", cdrag, & + call get_param(param_file, mdl, "CDRAG_SHELF", cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& "the velocity field to the surface stress.", units="nondim", & default=0.003) CS%cdrag = cdrag if (CS%ustar_bg <= 0.0) then - call get_param(param_file, mod, "DRAG_BG_VEL_SHELF", drag_bg_vel, & + call get_param(param_file, mdl, "DRAG_BG_VEL_SHELF", drag_bg_vel, & "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//& "LINEAR_DRAG) or an unresolved velocity that is \n"//& "combined with the resolved velocity to estimate the \n"//& @@ -1832,17 +1832,17 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti call MOM_mesg(" MOM_ice_shelf.F90, initialize_ice_shelf: reading calving_mask") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "CALVING_MASK_FILE", IC_file, & + call get_param(param_file, mdl, "CALVING_MASK_FILE", IC_file, & "The file with a mask for where calving might occur.", & default="ice_shelf_h.nc") - call get_param(param_file, mod, "CALVING_MASK_VARNAME", var_name, & + call get_param(param_file, mdl, "CALVING_MASK_VARNAME", var_name, & "The variable to use in masking calving.", & default="area_shelf_h") filename = trim(inputdir)//trim(IC_file) - call log_param(param_file, mod, "INPUTDIR/CALVING_MASK_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/CALVING_MASK_FILE", filename) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " calving mask file: Unable to open "//trim(filename)) @@ -1876,10 +1876,10 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, fluxes, Ti endif endif - call get_param(param_file, mod, "SAVE_INITIAL_CONDS", save_IC, & + call get_param(param_file, mdl, "SAVE_INITIAL_CONDS", save_IC, & "If true, save the ice shelf initial conditions.", & default=.false.) - if (save_IC) call get_param(param_file, mod, "SHELF_IC_OUTPUT_FILE", IC_file,& + if (save_IC) call get_param(param_file, mdl, "SHELF_IC_OUTPUT_FILE", IC_file,& "The name-root of the output file for the ice shelf \n"//& "initial conditions.", default="MOM_Shelf_IC") @@ -1973,7 +1973,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) character(len=240) :: config, inputdir, shelf_file, filename character(len=120) :: shelf_mass_var ! The name of shelf mass in the file. character(len=120) :: shelf_area_var ! The name of shelf area in the file. - character(len=40) :: mod = "MOM_ice_shelf" + character(len=40) :: mdl = "MOM_ice_shelf" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec if (.not. present(new_sim)) then @@ -1982,7 +1982,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) new_sim_2 = .false. endif - call get_param(param_file, mod, "ICE_SHELF_CONFIG", config, & + call get_param(param_file, mdl, "ICE_SHELF_CONFIG", config, & "A string that specifies how the ice shelf is \n"//& "initialized. Valid options include:\n"//& " \tfile\t Read from a file.\n"//& @@ -1995,23 +1995,23 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) call time_interp_external_init() - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "SHELF_FILE", shelf_file, & + call get_param(param_file, mdl, "SHELF_FILE", shelf_file, & "If DYNAMIC_SHELF_MASS = True, OVERRIDE_SHELF_MOVEMENT = True \n"//& "and ICE_SHELF_MASS_FROM_FILE = True, this is the file from \n"//& "which to read the shelf mass and area.", & default="shelf_mass.nc") - call get_param(param_file, mod, "SHELF_MASS_VAR", shelf_mass_var, & + call get_param(param_file, mdl, "SHELF_MASS_VAR", shelf_mass_var, & "The variable in SHELF_FILE with the shelf mass.", & default="shelf_mass") - call get_param(param_file, mod, "READ_SHELF_AREA", read_shelf_area, & + call get_param(param_file, mdl, "READ_SHELF_AREA", read_shelf_area, & "If true, also read the area covered by ice-shelf from SHELF_FILE.", & default=.false.) filename = trim(slasher(inputdir))//trim(shelf_file) - call log_param(param_file, mod, "INPUTDIR/SHELF_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/SHELF_FILE", filename) if (CS%DEBUG) then CS%id_read_mass = init_external_field(filename,shelf_mass_var, & @@ -2023,7 +2023,7 @@ subroutine initialize_shelf_mass(G, param_file, CS, new_sim) endif if (read_shelf_area) then - call get_param(param_file, mod, "SHELF_AREA_VAR", shelf_area_var, & + call get_param(param_file, mdl, "SHELF_AREA_VAR", shelf_area_var, & "The variable in SHELF_FILE with the shelf area.", & default="shelf_area") diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index f8787c7eb9..3a2c271d88 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -54,10 +54,10 @@ subroutine initialize_ice_thickness (h_shelf, area_shelf_h, hmask, G, PF) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: PF - character(len=40) :: mod = "initialize_ice_thickness" ! This subroutine's name. + character(len=40) :: mdl = "initialize_ice_thickness" ! This subroutine's name. character(len=200) :: config - call get_param(PF, mod, "ICE_PROFILE_CONFIG", config, & + call get_param(PF, mdl, "ICE_PROFILE_CONFIG", config, & "This specifies how the initial ice profile is specified. \n"//& "Valid values are: CHANNEL, FILE, and USER.", & fail_if_missing=.true.) @@ -83,27 +83,27 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, ! h_shelf and area_shelf_h in m (and dimensionless) and updates hmask character(len=200) :: filename,thickness_file,inputdir ! Strings for file/path character(len=200) :: thickness_varname, area_varname! Variable name in file - character(len=40) :: mod = "initialize_ice_thickness_from_file" ! This subroutine's name. + character(len=40) :: mdl = "initialize_ice_thickness_from_file" ! This subroutine's name. integer :: i, j, isc, jsc, iec, jec real :: len_sidestress, mask, udh call MOM_mesg(" MOM_ice_shelf_init_profile.F90, initialize_thickness_from_file: reading thickness") - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(PF, mod, "ICE_THICKNESS_FILE", thickness_file, & + call get_param(PF, mdl, "ICE_THICKNESS_FILE", thickness_file, & "The file from which the bathymetry is read.", & default="ice_shelf_h.nc") - call get_param(PF, mod, "LEN_SIDE_STRESS", len_sidestress, & + call get_param(PF, mdl, "LEN_SIDE_STRESS", len_sidestress, & "position past which shelf sides are stress free.", & default=0.0, units="axis_units") filename = trim(inputdir)//trim(thickness_file) - call log_param(PF, mod, "INPUTDIR/THICKNESS_FILE", filename) - call get_param(PF, mod, "ICE_THICKNESS_VARNAME", thickness_varname, & + call log_param(PF, mdl, "INPUTDIR/THICKNESS_FILE", filename) + call get_param(PF, mdl, "ICE_THICKNESS_VARNAME", thickness_varname, & "The name of the thickness variable in ICE_THICKNESS_FILE.", & default="h_shelf") - call get_param(PF, mod, "ICE_AREA_VARNAME", area_varname, & + call get_param(PF, mdl, "ICE_AREA_VARNAME", area_varname, & "The name of the area variable in ICE_THICKNESS_FILE.", & default="area_shelf_h") @@ -113,7 +113,7 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, call read_data(filename,trim(thickness_varname),h_shelf,domain=G%Domain%mpp_domain) call read_data(filename,trim(area_varname),area_shelf_h,domain=G%Domain%mpp_domain) -! call get_param(PF, mod, "ICE_BOUNDARY_CONFIG", config, & +! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified", & ! fail_if_missing=.true.) @@ -145,7 +145,7 @@ subroutine initialize_ice_thickness_from_file (h_shelf, area_shelf_h, hmask, G, elseif ((area_shelf_h(i,j) .gt. 0) .and. (area_shelf_h(i,j) .le. G%areaT(i,j))) then hmask(i,j) = 2. else - call MOM_error(FATAL,mod// " AREA IN CELL OUT OF RANGE") + call MOM_error(FATAL,mdl// " AREA IN CELL OUT OF RANGE") endif enddo enddo @@ -160,7 +160,7 @@ subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(param_file_type), intent(in) :: PF - character(len=40) :: mod = "initialize_ice_shelf_thickness_channel" ! This subroutine's name. + character(len=40) :: mdl = "initialize_ice_shelf_thickness_channel" ! This subroutine's name. real :: max_draft, min_draft, flat_shelf_width, c1, slope_pos real :: edge_pos, shelf_slope_scale, Rho_ocean integer :: i, j, jsc, jec, jsd, jed, jedg, nyh, isc, iec, isd, ied @@ -171,17 +171,17 @@ subroutine initialize_ice_thickness_channel (h_shelf, area_shelf_h, hmask, G, PF nyh = G%domain%njhalo ; jedg = G%domain%njglobal+nyh j_off = G%jdg_offset - call MOM_mesg(mod//": setting thickness") + call MOM_mesg(mdl//": setting thickness") - call get_param(PF, mod, "SHELF_MAX_DRAFT", max_draft, & + call get_param(PF, mdl, "SHELF_MAX_DRAFT", max_draft, & units="m", default=1.0) - call get_param(PF, mod, "SHELF_MIN_DRAFT", min_draft, & + call get_param(PF, mdl, "SHELF_MIN_DRAFT", min_draft, & units="m", default=1.0) - call get_param(PF, mod, "FLAT_SHELF_WIDTH", flat_shelf_width, & + call get_param(PF, mdl, "FLAT_SHELF_WIDTH", flat_shelf_width, & units="axis_units", default=0.0) - call get_param(PF, mod, "SHELF_SLOPE_SCALE", shelf_slope_scale, & + call get_param(PF, mdl, "SHELF_SLOPE_SCALE", shelf_slope_scale, & units="axis_units", default=0.0) - call get_param(PF, mod, "SHELF_EDGE_POS_0", edge_pos, & + call get_param(PF, mdl, "SHELF_EDGE_POS_0", edge_pos, & units="axis_units", default=0.0) slope_pos = edge_pos - flat_shelf_width @@ -252,15 +252,15 @@ end subroutine initialize_ice_thickness_channel ! real, intent(inout), dimension(:,:) :: hmask, h_boundary_values ! type(param_file_type), intent(in) :: PF -! character(len=40) :: mod = "initialize_ice_shelf_boundary" ! This subroutine's name. +! character(len=40) :: mdl = "initialize_ice_shelf_boundary" ! This subroutine's name. ! character(len=200) :: config ! logical flux_bdry -! call get_param(PF, mod, "ICE_BOUNDARY_CONFIG", config, & +! call get_param(PF, mdl, "ICE_BOUNDARY_CONFIG", config, & ! "This specifies how the ice domain boundary is specified. \n"//& ! "valid values include CHANNEL, FILE and USER.", & ! fail_if_missing=.true.) -! call get_param(PF, mod, "ICE_BOUNDARY_FLUX_CONDITION", flux_bdry, & +! call get_param(PF, mdl, "ICE_BOUNDARY_FLUX_CONDITION", flux_bdry, & ! "This specifies whether mass input is a dirichlet or \n"//& ! "flux condition", default=.true.) @@ -299,23 +299,23 @@ end subroutine initialize_ice_thickness_channel ! logical, intent(in) :: flux_bdry ! type (param_file_type), intent(in) :: PF -! character(len=40) :: mod = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. +! character(len=40) :: mdl = "initialize_ice_shelf_boundary_channel" ! This subroutine's name. ! integer :: i, j, isd, jsd, is, js, iegq, jegq, giec, gjec, gisc, gjsc, isc, jsc, iec, jec, ied, jed ! real :: lenlat, input_thick, input_flux, len_stress -! call get_param(PF, mod, "LENLAT", lenlat, fail_if_missing=.true.) +! call get_param(PF, mdl, "LENLAT", lenlat, fail_if_missing=.true.) -! call get_param(PF, mod, "INPUT_FLUX_ICE_SHELF", input_flux, & +! call get_param(PF, mdl, "INPUT_FLUX_ICE_SHELF", input_flux, & ! "volume flux at upstream boundary", & ! units="m2 s-1", default=0.) -! call get_param(PF, mod, "INPUT_THICK_ICE_SHELF", input_thick, & +! call get_param(PF, mdl, "INPUT_THICK_ICE_SHELF", input_thick, & ! "flux thickness at upstream boundary", & ! units="m", default=1000.) -! call get_param(PF, mod, "LEN_SIDE_STRESS", len_stress, & +! call get_param(PF, mdl, "LEN_SIDE_STRESS", len_stress, & ! "maximum position of no-flow condition in along-flow direction", & ! units="km", default=0.) -! call MOM_mesg(mod//": setting boundary") +! call MOM_mesg(mdl//": setting boundary") ! isd = G%isd ; ied = G%ied ! jsd = G%jsd ; jed = G%jed diff --git a/src/ice_shelf/user_shelf_init.F90 b/src/ice_shelf/user_shelf_init.F90 index 027fced58f..1afd1816d4 100644 --- a/src/ice_shelf/user_shelf_init.F90 +++ b/src/ice_shelf/user_shelf_init.F90 @@ -135,7 +135,7 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, real :: min_draft ! The minimum ocean draft of the ice shelf, in m. real :: flat_shelf_width ! The range over which the shelf is min_draft thick. real :: c1 ! The maximum depths in m. - character(len=40) :: mod = "USER_initialize_shelf_mass" ! This subroutine's name. + character(len=40) :: mdl = "USER_initialize_shelf_mass" ! This subroutine's name. integer :: i, j ! call MOM_error(FATAL, "USER_shelf_init.F90, USER_set_shelf_mass: " // & @@ -145,23 +145,23 @@ subroutine USER_initialize_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, ! Read all relevant parameters and write them to the model log. if (first_call) call write_user_log(param_file) - call get_param(param_file, mod, "RHO_0", CS%Rho_ocean, & + call get_param(param_file, mdl, "RHO_0", CS%Rho_ocean, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "SHELF_MAX_DRAFT", CS%max_draft, & + call get_param(param_file, mdl, "SHELF_MAX_DRAFT", CS%max_draft, & units="m", default=1.0) - call get_param(param_file, mod, "SHELF_MIN_DRAFT", CS%min_draft, & + call get_param(param_file, mdl, "SHELF_MIN_DRAFT", CS%min_draft, & units="m", default=1.0) - call get_param(param_file, mod, "FLAT_SHELF_WIDTH", CS%flat_shelf_width, & + call get_param(param_file, mdl, "FLAT_SHELF_WIDTH", CS%flat_shelf_width, & units="axis_units", default=0.0) - call get_param(param_file, mod, "SHELF_SLOPE_SCALE", CS%shelf_slope_scale, & + call get_param(param_file, mdl, "SHELF_SLOPE_SCALE", CS%shelf_slope_scale, & units="axis_units", default=0.0) - call get_param(param_file, mod, "SHELF_EDGE_POS_0", CS%pos_shelf_edge_0, & + call get_param(param_file, mdl, "SHELF_EDGE_POS_0", CS%pos_shelf_edge_0, & units="axis_units", default=0.0) - call get_param(param_file, mod, "SHELF_SPEED", CS%shelf_speed, & + call get_param(param_file, mdl, "SHELF_SPEED", CS%shelf_speed, & units="axis_units day-1", default=0.0) call USER_update_shelf_mass(mass_shelf, area_shelf_h, h_shelf, hmask, G, CS, set_time(0,0), new_sim) @@ -262,9 +262,9 @@ subroutine write_user_log(param_file) character(len=128) :: version = '$Id: user_shelf_init.F90,v 1.1.2.7 2012/06/19 22:15:52 Robert.Hallberg Exp $' character(len=128) :: tagname = '$Name: MOM_ogrp $' - character(len=40) :: mod = "user_shelf_init" ! This module's name. + character(len=40) :: mdl = "user_shelf_init" ! This module's name. - call log_version(param_file, mod, version, tagname) + call log_version(param_file, mdl, version, tagname) first_call = .false. end subroutine write_user_log diff --git a/src/initialization/MOM_coord_initialization.F90 b/src/initialization/MOM_coord_initialization.F90 index 094e7617eb..ba1cab27bb 100644 --- a/src/initialization/MOM_coord_initialization.F90 +++ b/src/initialization/MOM_coord_initialization.F90 @@ -24,7 +24,7 @@ module MOM_coord_initialization public MOM_initialize_coord -character(len=40) :: mod = "MOM_coord_initialization" ! This module's name. +character(len=40) :: mdl = "MOM_coord_initialization" ! This module's name. contains @@ -52,11 +52,11 @@ subroutine MOM_initialize_coord(GV, PF, write_geom, output_dir, tv, max_depth) nz = GV%ke call callTree_enter("MOM_initialize_coord(), MOM_coord_initialization.F90") - call log_version(PF, mod, version, "") - call get_param(PF, mod, "DEBUG", debug, default=.false.) + call log_version(PF, mdl, version, "") + call get_param(PF, mdl, "DEBUG", debug, default=.false.) ! Set-up the layer densities, GV%Rlay, and reduced gravities, GV%g_prime. - call get_param(PF, mod, "COORD_CONFIG", config, & + call get_param(PF, mdl, "COORD_CONFIG", config, & "This specifies how layers are to be defined: \n"//& " \t ALE or none - used to avoid defining layers in ALE mode \n"//& " \t file - read coordinate information from the file \n"//& @@ -130,16 +130,16 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) ! reduced gravities (g). ! real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. real :: g_fs ! Reduced gravity across the free surface, in m s-2. - character(len=40) :: mod = "set_coord_from_gprime" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_gprime" ! This subroutine's name. integer :: k, nz nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "GFS" , g_fs, & + call get_param(param_file, mdl, "GFS" , g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) - call get_param(param_file, mod, "GINT", g_int, & + call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) @@ -148,7 +148,7 @@ subroutine set_coord_from_gprime(Rlay, g_prime, GV, param_file) Rlay(1) = GV%Rho0 do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_gprime ! ----------------------------------------------------------------------------- @@ -169,19 +169,19 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) real :: g_fs ! Reduced gravity across the free surface, in m s-2. real :: Rlay_Ref! The surface layer's target density, in kg m-3. real :: RLay_range ! The range of densities, in kg m-3. - character(len=40) :: mod = "set_coord_from_layer_density" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_layer_density" ! This subroutine's name. integer :: k, nz nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) - call get_param(param_file, mod, "LIGHTEST_DENSITY", Rlay_Ref, & + call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for layer 1.", & units="kg m-3", default=GV%Rho0) - call get_param(param_file, mod, "DENSITY_RANGE", Rlay_range, & + call get_param(param_file, mdl, "DENSITY_RANGE", Rlay_range, & "The range of reference potential densities in the layers.", & units="kg m-3", default=2.0) @@ -195,7 +195,7 @@ subroutine set_coord_from_layer_density(Rlay, g_prime, GV, param_file) g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_layer_density ! ----------------------------------------------------------------------------- @@ -221,21 +221,21 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & real :: S_ref ! Reference salinity real :: g_int ! Reduced gravities across the internal interfaces, in m s-2. real :: g_fs ! Reduced gravity across the free surface, in m s-2. - character(len=40) :: mod = "set_coord_from_TS_ref" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_TS_ref" ! This subroutine's name. integer :: k, nz nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "T_REF", T_Ref, & + call get_param(param_file, mdl, "T_REF", T_Ref, & "The initial temperature of the lightest layer.", units="degC", & fail_if_missing=.true.) - call get_param(param_file, mod, "S_REF", S_Ref, & + call get_param(param_file, mdl, "S_REF", S_Ref, & "The initial salinities.", units="PSU", default=35.0) - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) - call get_param(param_file, mod, "GINT", g_int, & + call get_param(param_file, mdl, "GINT", g_int, & "The reduced gravity across internal interfaces.", & units="m s-2", fail_if_missing=.true.) ! @@ -251,7 +251,7 @@ subroutine set_coord_from_TS_ref(Rlay, g_prime, GV, param_file, eqn_of_state, & ! These statements set the layer densities. ! do k=2,nz ; Rlay(k) = Rlay(k-1) + g_prime(k)*(GV%Rho0/GV%g_Earth) ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_ref ! ----------------------------------------------------------------------------- @@ -276,22 +276,22 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & real, dimension(GV%ke) :: T0, S0, Pref real :: g_fs ! Reduced gravity across the free surface, in m s-2. integer :: k, nz - character(len=40) :: mod = "set_coord_from_TS_profile" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_TS_profile" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) - call get_param(param_file, mod, "COORD_FILE", coord_file, & + call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate temperatures and \n"//& "salnities are read.", fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") filename = trim(slasher(inputdir))//trim(coord_file) - call log_param(param_file, mod, "INPUTDIR/COORD_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) call read_data(filename,"PTEMP",T0(:)) call read_data(filename,"SALT",S0(:)) @@ -304,7 +304,7 @@ subroutine set_coord_from_TS_profile(Rlay, g_prime, GV, param_file, & call calculate_density(T0, S0, Pref, Rlay, 1,nz,eqn_of_state) do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_profile ! ----------------------------------------------------------------------------- @@ -336,38 +336,38 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & real :: g_fs ! Reduced gravity across the free surface, in m s-2. real :: a1, frac_dense, k_frac integer :: k, nz, k_light - character(len=40) :: mod = "set_coord_from_TS_range" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_TS_range" ! This subroutine's name. character(len=200) :: filename, coord_file, inputdir ! Strings for file/path nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "T_REF", T_Ref, & + call get_param(param_file, mdl, "T_REF", T_Ref, & "The default initial temperatures.", units="degC", default=10.0) - call get_param(param_file, mod, "TS_RANGE_T_LIGHT", T_Light, & + call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_Light, & "The initial temperature of the lightest layer when \n"//& "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) - call get_param(param_file, mod, "TS_RANGE_T_DENSE", T_Dense, & + call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_Dense, & "The initial temperature of the densest layer when \n"//& "COORD_CONFIG is set to ts_range.", units="degC", default=T_Ref) - call get_param(param_file, mod, "S_REF", S_Ref, & + call get_param(param_file, mdl, "S_REF", S_Ref, & "The default initial salinities.", units="PSU", default=35.0) - call get_param(param_file, mod, "TS_RANGE_S_LIGHT", S_Light, & + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_Light, & "The initial lightest salinities when COORD_CONFIG \n"//& "is set to ts_range.", default = S_Ref, units="PSU") - call get_param(param_file, mod, "TS_RANGE_S_DENSE", S_Dense, & + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_Dense, & "The initial densest salinities when COORD_CONFIG \n"//& "is set to ts_range.", default = S_Ref, units="PSU") - call get_param(param_file, mod, "TS_RANGE_RESOLN_RATIO", res_rat, & + call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, & "The ratio of density space resolution in the densest \n"//& "part of the range to that in the lightest part of the \n"//& "range when COORD_CONFIG is set to ts_range. Values \n"//& "greater than 1 increase the resolution of the denser water.",& default=1.0, units="nondim") - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) @@ -392,7 +392,7 @@ subroutine set_coord_from_TS_range(Rlay, g_prime, GV, param_file, & enddo do k=2,nz; g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)); enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_TS_range ! ----------------------------------------------------------------------------- @@ -411,26 +411,26 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) ! reduced gravities (g). ! real :: g_fs ! Reduced gravity across the free surface, in m s-2. integer :: k, nz - character(len=40) :: mod = "set_coord_from_file" ! This subroutine's name. + character(len=40) :: mdl = "set_coord_from_file" ! This subroutine's name. character(len=40) :: coord_var character(len=200) :: filename,coord_file,inputdir ! Strings for file/path nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "COORD_FILE", coord_file, & + call get_param(param_file, mdl, "COORD_FILE", coord_file, & "The file from which the coordinate densities are read.", & fail_if_missing=.true.) - call get_param(param_file, mod, "COORD_VAR", coord_var, & + call get_param(param_file, mdl, "COORD_VAR", coord_var, & "The variable in COORD_FILE that is to be used for the \n"//& "coordinate densities.", default="Layer") filename = trim(inputdir)//trim(coord_file) - call log_param(param_file, mod, "INPUTDIR/COORD_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/COORD_FILE", filename) if (.not.file_exists(filename)) call MOM_error(FATAL, & " set_coord_from_file: Unable to open "//trim(filename)) @@ -443,7 +443,7 @@ subroutine set_coord_from_file(Rlay, g_prime, GV, param_file) trim(filename)) endif ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_from_file ! ----------------------------------------------------------------------------- @@ -463,20 +463,20 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) ! reference surface layer density and spanning a range of densities ! to the bottom defined by the parameter RLAY_RANGE ! (defaulting to 2.0 if not defined) - character(len=40) :: mod = "set_coord_linear" ! This subroutine + character(len=40) :: mdl = "set_coord_linear" ! This subroutine real :: Rlay_ref, Rlay_range, g_fs integer :: k, nz nz = GV%ke - call callTree_enter(trim(mod)//"(), MOM_coord_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_coord_initialization.F90") - call get_param(param_file, mod, "LIGHTEST_DENSITY", Rlay_Ref, & + call get_param(param_file, mdl, "LIGHTEST_DENSITY", Rlay_Ref, & "The reference potential density used for the surface \n"// & "interface.", units="kg m-3", default=GV%Rho0) - call get_param(param_file, mod, "DENSITY_RANGE", Rlay_range, & + call get_param(param_file, mdl, "DENSITY_RANGE", Rlay_range, & "The range of reference potential densities across \n"// & "all interfaces.", units="kg m-3", default=2.0) - call get_param(param_file, mod, "GFS", g_fs, & + call get_param(param_file, mdl, "GFS", g_fs, & "The reduced gravity at the free surface.", units="m s-2", & default=GV%g_Earth) @@ -492,7 +492,7 @@ subroutine set_coord_linear(Rlay, g_prime, GV, param_file) g_prime(k) = (GV%g_Earth/GV%Rho0) * (Rlay(k) - Rlay(k-1)) enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_coord_linear !> Sets Rlay to Rho0 and g_prime to zero except for the free surface. diff --git a/src/initialization/MOM_fixed_initialization.F90 b/src/initialization/MOM_fixed_initialization.F90 index 6b99d9bc58..afa0d058a7 100644 --- a/src/initialization/MOM_fixed_initialization.F90 +++ b/src/initialization/MOM_fixed_initialization.F90 @@ -61,16 +61,16 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! Local character(len=200) :: inputdir ! The directory where NetCDF input files are. character(len=200) :: config - character(len=40) :: mod = "MOM_fixed_initialization" ! This module's name. + character(len=40) :: mdl = "MOM_fixed_initialization" ! This module's name. logical :: debug ! This include declares and sets the variable "version". #include "version_variable.h" call callTree_enter("MOM_initialize_fixed(), MOM_fixed_initialization.F90") - call log_version(PF, mod, version, "") - call get_param(PF, mod, "DEBUG", debug, default=.false.) + call log_version(PF, mdl, version, "") + call get_param(PF, mdl, "DEBUG", debug, default=.false.) - call get_param(PF, mod, "INPUTDIR", inputdir, & + call get_param(PF, mdl, "INPUTDIR", inputdir, & "The directory in which input files are found.", default=".") inputdir = slasher(inputdir) @@ -106,7 +106,7 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) endif ! Modulate geometric scales according to geography. - call get_param(PF, mod, "CHANNEL_CONFIG", config, & + call get_param(PF, mdl, "CHANNEL_CONFIG", config, & "A parameter that determines which set of channels are \n"//& "restricted to specific widths. Options are:\n"//& " \t none - All channels have the grid width.\n"//& @@ -129,7 +129,7 @@ subroutine MOM_initialize_fixed(G, OBC, PF, write_geom, output_dir) ! This call sets the topography at velocity points. if (G%bathymetry_at_vel) then - call get_param(PF, mod, "VELOCITY_DEPTH_CONFIG", config, & + call get_param(PF, mdl, "VELOCITY_DEPTH_CONFIG", config, & "A string that determines how the topography is set at \n"//& "velocity points. This may be 'min' or 'max'.", & default="max") @@ -176,10 +176,10 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Set up the bottom depth, G%bathyT either analytically or from file - character(len=40) :: mod = "MOM_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "MOM_initialize_topography" ! This subroutine's name. character(len=200) :: config - call get_param(PF, mod, "TOPO_CONFIG", config, & + call get_param(PF, mdl, "TOPO_CONFIG", config, & "This specifies how bathymetry is specified: \n"//& " \t file - read bathymetric information from the file \n"//& " \t\t specified by (TOPO_FILE).\n"//& @@ -228,11 +228,11 @@ subroutine MOM_initialize_topography(D, max_depth, G, PF) "Unrecognized topography setup '"//trim(config)//"'") end select if (max_depth>0.) then - call log_param(PF, mod, "MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "MAXIMUM_DEPTH", max_depth, & "The maximum depth of the ocean.", units="m") else max_depth = diagnoseMaximumDepth(D,G) - call log_param(PF, mod, "!MAXIMUM_DEPTH", max_depth, & + call log_param(PF, mdl, "!MAXIMUM_DEPTH", max_depth, & "The (diagnosed) maximum depth of the ocean.", units="m") endif if (trim(config) .ne. "DOME") then diff --git a/src/initialization/MOM_grid_initialize.F90 b/src/initialization/MOM_grid_initialize.F90 index bf6c4cf249..822d9a4ba5 100644 --- a/src/initialization/MOM_grid_initialize.F90 +++ b/src/initialization/MOM_grid_initialize.F90 @@ -247,7 +247,7 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) real, dimension(2*G%isd-3:2*G%ied+1,2*G%jsd-3:2*G%jed+1) :: tmpZ real, dimension(:,:), allocatable :: tmpGlbl character(len=200) :: filename, grid_file, inputdir - character(len=64) :: mod="MOM_grid_init set_grid_metrics_from_mosaic" + character(len=64) :: mdl = "MOM_grid_init set_grid_metrics_from_mosaic" integer :: err=0, ni, nj, global_indices(4) type(MOM_domain_type) :: SGdom ! Supergrid domain integer :: i, j, i2, j2 @@ -257,13 +257,13 @@ subroutine set_grid_metrics_from_mosaic(G, param_file) call callTree_enter("set_grid_metrics_from_mosaic(), MOM_grid_initialize.F90") - call get_param(param_file, mod, "GRID_FILE", grid_file, & + call get_param(param_file, mdl, "GRID_FILE", grid_file, & "Name of the file from which to read horizontal grid data.", & fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(adjustl(inputdir)) // trim(adjustl(grid_file)) - call log_param(param_file, mod, "INPUTDIR/GRID_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/GRID_FILE", filename) if (.not.file_exists(filename)) & call MOM_error(FATAL," set_grid_metrics_from_mosaic: Unable to open "//& trim(filename)) @@ -484,7 +484,7 @@ subroutine set_grid_metrics_cartesian(G, param_file) real :: I_dx, I_dy ! Inverse grid spacings in m. real :: PI character(len=80) :: units_temp - character(len=48) :: mod = "MOM_grid_init set_grid_metrics_cartesian" + character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_cartesian" niglobal = G%Domain%niglobal ; njglobal = G%Domain%njglobal isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -495,25 +495,25 @@ subroutine set_grid_metrics_cartesian(G, param_file) PI = 4.0*atan(1.0) ; - call get_param(param_file, mod, "AXIS_UNITS", units_temp, & + call get_param(param_file, mdl, "AXIS_UNITS", units_temp, & "The units for the Cartesian axes. Valid entries are: \n"//& " \t degrees - degrees of latitude and longitude \n"//& " \t m - meters \n \t k - kilometers", default="degrees") - call get_param(param_file, mod, "SOUTHLAT", G%south_lat, & + call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & "The southern latitude of the domain or the equivalent \n"//& "starting value for the y-axis.", units=units_temp, & fail_if_missing=.true.) - call get_param(param_file, mod, "LENLAT", G%len_lat, & + call get_param(param_file, mdl, "LENLAT", G%len_lat, & "The latitudinal or y-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) - call get_param(param_file, mod, "WESTLON", G%west_lon, & + call get_param(param_file, mdl, "WESTLON", G%west_lon, & "The western longitude of the domain or the equivalent \n"//& "starting value for the x-axis.", units=units_temp, & default=0.0) - call get_param(param_file, mod, "LENLON", G%len_lon, & + call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal or x-direction length of the domain.", & units=units_temp, fail_if_missing=.true.) - call get_param(param_file, mod, "RAD_EARTH", G%Rad_Earth, & + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & "The radius of the Earth.", units="m", default=6.378e6) if (units_temp(1:1) == 'k') then @@ -521,7 +521,7 @@ subroutine set_grid_metrics_cartesian(G, param_file) elseif (units_temp(1:1) == 'm') then G%x_axis_units = "meters" ; G%y_axis_units = "meters" endif - call log_param(param_file, mod, "explicit AXIS_UNITS", G%x_axis_units) + call log_param(param_file, mdl, "explicit AXIS_UNITS", G%x_axis_units) ! Note that the dynamic grid always uses symmetric memory for the global ! arrays G%gridLatB and G%gridLonB. @@ -620,7 +620,7 @@ subroutine set_grid_metrics_spherical(G, param_file) real :: grid_latT(G%jsd:G%jed), grid_latB(G%JsdB:G%JedB) real :: grid_lonT(G%isd:G%ied), grid_lonB(G%IsdB:G%IedB) real :: dLon,dLat,latitude,longitude,dL_di - character(len=48) :: mod = "MOM_grid_init set_grid_metrics_spherical" + character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_spherical" is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -634,19 +634,19 @@ subroutine set_grid_metrics_spherical(G, param_file) ! and save them in arrays. PI = 4.0*atan(1.0); PI_180 = atan(1.0)/45. - call get_param(param_file, mod, "SOUTHLAT", G%south_lat, & + call get_param(param_file, mdl, "SOUTHLAT", G%south_lat, & "The southern latitude of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "LENLAT", G%len_lat, & + call get_param(param_file, mdl, "LENLAT", G%len_lat, & "The latitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "WESTLON", G%west_lon, & + call get_param(param_file, mdl, "WESTLON", G%west_lon, & "The western longitude of the domain.", units="degrees", & default=0.0) - call get_param(param_file, mod, "LENLON", G%len_lon, & + call get_param(param_file, mdl, "LENLON", G%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "RAD_EARTH", G%Rad_Earth, & + call get_param(param_file, mdl, "RAD_EARTH", G%Rad_Earth, & "The radius of the Earth.", units="m", default=6.378e6) dLon = G%len_lon/G%Domain%niglobal @@ -759,7 +759,7 @@ subroutine set_grid_metrics_mercator(G, param_file) integer :: I_off, J_off type(GPS) :: GP character(len=128) :: warnmesg - character(len=48) :: mod = "MOM_grid_init set_grid_metrics_mercator" + character(len=48) :: mdl = "MOM_grid_init set_grid_metrics_mercator" real :: PI, PI_2! PI = 3.1415926... as 4*atan(1), PI_2 = (PI) /2.0 @@ -799,24 +799,24 @@ subroutine set_grid_metrics_mercator(G, param_file) ! and save them in arrays. PI = 4.0*atan(1.0) ; PI_2 = 0.5*PI - call get_param(param_file, mod, "SOUTHLAT", GP%south_lat, & + call get_param(param_file, mdl, "SOUTHLAT", GP%south_lat, & "The southern latitude of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "LENLAT", GP%len_lat, & + call get_param(param_file, mdl, "LENLAT", GP%len_lat, & "The latitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "WESTLON", GP%west_lon, & + call get_param(param_file, mdl, "WESTLON", GP%west_lon, & "The western longitude of the domain.", units="degrees", & default=0.0) - call get_param(param_file, mod, "LENLON", GP%len_lon, & + call get_param(param_file, mdl, "LENLON", GP%len_lon, & "The longitudinal length of the domain.", units="degrees", & fail_if_missing=.true.) - call get_param(param_file, mod, "RAD_EARTH", GP%Rad_Earth, & + call get_param(param_file, mdl, "RAD_EARTH", GP%Rad_Earth, & "The radius of the Earth.", units="m", default=6.378e6) G%south_lat = GP%south_lat ; G%len_lat = GP%len_lat G%west_lon = GP%west_lon ; G%len_lon = GP%len_lon G%Rad_Earth = GP%Rad_Earth - call get_param(param_file, mod, "ISOTROPIC", GP%isotropic, & + call get_param(param_file, mdl, "ISOTROPIC", GP%isotropic, & "If true, an isotropic grid on a sphere (also known as \n"//& "a Mercator grid) is used. With an isotropic grid, the \n"//& "meridional extent of the domain (LENLAT), the zonal \n"//& @@ -825,15 +825,15 @@ subroutine set_grid_metrics_mercator(G, param_file) "extent is determined to fit the zonal extent and the \n"//& "number of grid points, while grid is perfectly isotropic.", & default=.false.) - call get_param(param_file, mod, "EQUATOR_REFERENCE", GP%equator_reference, & + call get_param(param_file, mdl, "EQUATOR_REFERENCE", GP%equator_reference, & "If true, the grid is defined to have the equator at the \n"//& "nearest q- or h- grid point to (-LOWLAT*NJGLOBAL/LENLAT).", & default=.true.) - call get_param(param_file, mod, "LAT_ENHANCE_FACTOR", GP%Lat_enhance_factor, & + call get_param(param_file, mdl, "LAT_ENHANCE_FACTOR", GP%Lat_enhance_factor, & "The amount by which the meridional resolution is \n"//& "enhanced within LAT_EQ_ENHANCE of the equator.", & units="nondim", default=1.0) - call get_param(param_file, mod, "LAT_EQ_ENHANCE", GP%Lat_eq_enhance, & + call get_param(param_file, mdl, "LAT_EQ_ENHANCE", GP%Lat_eq_enhance, & "The latitude range to the north and south of the equator \n"//& "over which the resolution is enhanced.", units="degrees", & default=0.0) @@ -1297,17 +1297,17 @@ subroutine initialize_masks(G, PF) ! mask2dCv, and mask2dBu are all 1.0. real :: Dmin, min_depth, mask_depth - character(len=40) :: mod = "MOM_grid_init initialize_masks" + character(len=40) :: mdl = "MOM_grid_init initialize_masks" integer :: i, j call callTree_enter("initialize_masks(), MOM_grid_initialize.F90") - call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than\n"//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & units="m", default=0.0) - call get_param(PF, mod, "MASKING_DEPTH", mask_depth, & + call get_param(PF, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask points as land points, for which all\n"//& "fluxes are zeroed out. MASKING_DEPTH is ignored if negative.", & units="m", default=-9999.0) diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index c8d14a1c99..ad4961b387 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -37,11 +37,11 @@ subroutine MOM_shared_init_init(PF) type(param_file_type), intent(in) :: PF !< A structure indicating the open file !! to parse for model parameter values. - character(len=40) :: mod = "MOM_shared_initialization" ! This module's name. + character(len=40) :: mdl = "MOM_shared_initialization" ! This module's name. ! This include declares and sets the variable "version". #include "version_variable.h" - call log_version(PF, mod, version, & + call log_version(PF, mdl, version, & "Sharable code to initialize time-invariant fields, like bathymetry and Coriolis parameters.") end subroutine MOM_shared_init_init @@ -57,11 +57,11 @@ subroutine MOM_initialize_rotation(f, G, PF) ! This is a separate subroutine so that it can be made public and shared with ! the ice-sheet code or other components. ! Set up the Coriolis parameter, f, either analytically or from file. - character(len=40) :: mod = "MOM_initialize_rotation" ! This subroutine's name. + character(len=40) :: mdl = "MOM_initialize_rotation" ! This subroutine's name. character(len=200) :: config - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") - call get_param(PF, mod, "ROTATION", config, & + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") + call get_param(PF, mdl, "ROTATION", config, & "This specifies how the Coriolis parameter is specified: \n"//& " \t 2omegasinlat - Use twice the planetary rotation rate \n"//& " \t\t times the sine of latitude.\n"//& @@ -76,7 +76,7 @@ subroutine MOM_initialize_rotation(f, G, PF) case default ; call MOM_error(FATAL,"MOM_initialize: "// & "Unrecognized rotation setup "//trim(config)) end select - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine MOM_initialize_rotation !> Calculates the components of grad f (Coriolis parameter) @@ -135,21 +135,21 @@ subroutine initialize_topography_from_file(D, G, param_file) ! Local variables character(len=200) :: filename, topo_file, inputdir ! Strings for file/path character(len=200) :: topo_varname ! Variable name in file - character(len=40) :: mod = "initialize_topography_from_file" ! This subroutine's name. + character(len=40) :: mdl = "initialize_topography_from_file" ! This subroutine's name. - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "TOPO_FILE", topo_file, & + call get_param(param_file, mdl, "TOPO_FILE", topo_file, & "The file from which the bathymetry is read.", & default="topog.nc") - call get_param(param_file, mod, "TOPO_VARNAME", topo_varname, & + call get_param(param_file, mdl, "TOPO_VARNAME", topo_varname, & "The name of the bathymetry variable in TOPO_FILE.", & default="depth") filename = trim(inputdir)//trim(topo_file) - call log_param(param_file, mod, "INPUTDIR/TOPO_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/TOPO_FILE", filename) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_topography_from_file: Unable to open "//trim(filename)) @@ -165,7 +165,7 @@ subroutine initialize_topography_from_file(D, G, param_file) call apply_topography_edits_from_file(D, G, param_file) - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_topography_from_file !> Applies a list of topography overrides read from a netcdf file @@ -177,16 +177,16 @@ subroutine apply_topography_edits_from_file(D, G, param_file) ! Local variables character(len=200) :: topo_edits_file, inputdir ! Strings for file/path - character(len=40) :: mod = "apply_topography_edits_from_file" ! This subroutine's name. + character(len=40) :: mdl = "apply_topography_edits_from_file" ! This subroutine's name. integer :: n_edits, n, ashape(5), i, j, ncid, id, ncstatus, iid, jid, zid integer, dimension(:), allocatable :: ig, jg real, dimension(:), allocatable :: new_depth - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "TOPO_EDITS_FILE", topo_edits_file, & + call get_param(param_file, mdl, "TOPO_EDITS_FILE", topo_edits_file, & "The file from which to read a list of i,j,z topography overrides.", & default="") @@ -276,7 +276,7 @@ subroutine apply_topography_edits_from_file(D, G, param_file) deallocate( ig, jg, new_depth ) - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine apply_topography_edits_from_file !> initialize the bathymetry based on one of several named idealized configurations @@ -306,38 +306,38 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth real :: Dedge ! The depth in m at the basin edge. ! ! real :: south_lat, west_lon, len_lon, len_lat, Rad_earth integer :: i, j, is, ie, js, je, isd, ied, jsd, jed - character(len=40) :: mod = "initialize_topography_named" ! This subroutine's name. + character(len=40) :: mdl = "initialize_topography_named" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") call MOM_mesg(" MOM_shared_initialization.F90, initialize_topography_named: "//& "TOPO_CONFIG = "//trim(topog_config), 5) - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) if (max_depth<=0.) call MOM_error(FATAL,"initialize_topography_named: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") if (trim(topog_config) /= "flat") then - call get_param(param_file, mod, "EDGE_DEPTH", Dedge, & + call get_param(param_file, mdl, "EDGE_DEPTH", Dedge, & "The depth at the edge of one of the named topographies.", & units="m", default=100.0) -! call get_param(param_file, mod, "SOUTHLAT", south_lat, & +! call get_param(param_file, mdl, "SOUTHLAT", south_lat, & ! "The southern latitude of the domain.", units="degrees", & ! fail_if_missing=.true.) -! call get_param(param_file, mod, "LENLAT", len_lat, & +! call get_param(param_file, mdl, "LENLAT", len_lat, & ! "The latitudinal length of the domain.", units="degrees", & ! fail_if_missing=.true.) -! call get_param(param_file, mod, "WESTLON", west_lon, & +! call get_param(param_file, mdl, "WESTLON", west_lon, & ! "The western longitude of the domain.", units="degrees", & ! default=0.0) -! call get_param(param_file, mod, "LENLON", len_lon, & +! call get_param(param_file, mdl, "LENLON", len_lon, & ! "The longitudinal length of the domain.", units="degrees", & ! fail_if_missing=.true.) -! call get_param(param_file, mod, "RAD_EARTH", Rad_Earth, & +! call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & ! "The radius of the Earth.", units="m", default=6.378e6) - call get_param(param_file, mod, "TOPOG_SLOPE_SCALE", expdecay, & + call get_param(param_file, mdl, "TOPOG_SLOPE_SCALE", expdecay, & "The exponential decay scale used in defining some of \n"//& "the named topographies.", units="m", default=400000.0) endif @@ -390,7 +390,7 @@ subroutine initialize_topography_named(D, G, param_file, topog_config, max_depth if (D(i,j) < min_depth) D(i,j) = 0.5*min_depth enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_topography_named ! ----------------------------------------------------------------------------- @@ -410,18 +410,18 @@ subroutine limit_topography(D, G, param_file, max_depth) ! This subroutine ensures that min_depth < D(x,y) < max_depth integer :: i, j - character(len=40) :: mod = "limit_topography" ! This subroutine's name. + character(len=40) :: mdl = "limit_topography" ! This subroutine's name. real :: min_depth, mask_depth - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "If MASKING_DEPTH is unspecified, then anything shallower than\n"//& "MINIMUM_DEPTH is assumed to be land and all fluxes are masked out.\n"//& "If MASKING_DEPTH is specified, then all depths shallower than\n"//& "MINIMUM_DEPTH but deeper than MASKING_DEPTH are rounded to MINIMUM_DEPTH.", & units="m", default=0.0) - call get_param(param_file, mod, "MASKING_DEPTH", mask_depth, & + call get_param(param_file, mdl, "MASKING_DEPTH", mask_depth, & "The depth below which to mask the ocean as land.", units="m", & default=-9999.0, do_not_log=.true.) @@ -440,7 +440,7 @@ subroutine limit_topography(D, G, param_file, max_depth) enddo ; enddo endif - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine limit_topography ! ----------------------------------------------------------------------------- @@ -454,11 +454,11 @@ subroutine set_rotation_planetary(f, G, param_file) ! (in) param_file - parameter file type ! This subroutine sets up the Coriolis parameter for a sphere - character(len=30) :: mod = "set_rotation_planetary" ! This subroutine's name. + character(len=30) :: mdl = "set_rotation_planetary" ! This subroutine's name. integer :: I, J real :: PI, omega - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") call get_param(param_file, "set_rotation_planetary", "OMEGA", omega, & "The rotation rate of the earth.", units="s-1", & @@ -469,7 +469,7 @@ subroutine set_rotation_planetary(f, G, param_file) f(I,J) = ( 2.0 * omega ) * sin( ( PI * G%geoLatBu(I,J) ) / 180.) enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_rotation_planetary ! ----------------------------------------------------------------------------- @@ -485,23 +485,23 @@ subroutine set_rotation_beta_plane(f, G, param_file) ! This subroutine sets up the Coriolis parameter for a beta-plane integer :: I, J real :: f_0, beta, y_scl, Rad_Earth, PI - character(len=40) :: mod = "set_rotation_beta_plane" ! This subroutine's name. + character(len=40) :: mdl = "set_rotation_beta_plane" ! This subroutine's name. character(len=200) :: axis_units - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "F_0", f_0, & + call get_param(param_file, mdl, "F_0", f_0, & "The reference value of the Coriolis parameter with the \n"//& "betaplane option.", units="s-1", default=0.0) - call get_param(param_file, mod, "BETA", beta, & + call get_param(param_file, mdl, "BETA", beta, & "The northward gradient of the Coriolis parameter with \n"//& "the betaplane option.", units="m-1 s-1", default=0.0) - call get_param(param_file, mod, "AXIS_UNITS", axis_units, default="degrees") + call get_param(param_file, mdl, "AXIS_UNITS", axis_units, default="degrees") PI = 4.0*atan(1.0) select case (axis_units(1:1)) case ("d") - call get_param(param_file, mod, "RAD_EARTH", Rad_Earth, & + call get_param(param_file, mdl, "RAD_EARTH", Rad_Earth, & "The radius of the Earth.", units="m", default=6.378e6) y_scl = Rad_Earth/PI case ("k"); y_scl = 1.E3 @@ -515,7 +515,7 @@ subroutine set_rotation_beta_plane(f, G, param_file) f(I,J) = f_0 + beta * ( G%geoLatBu(I,J) * y_scl ) enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine set_rotation_beta_plane !> initialize_grid_rotation_angle initializes the arrays with the sine and @@ -680,7 +680,7 @@ subroutine reset_face_lengths_file(G, param_file) ! Arguments: G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for ! model parameter values. - character(len=40) :: mod = "reset_face_lengths_file" ! This subroutine's name. + character(len=40) :: mdl = "reset_face_lengths_file" ! This subroutine's name. character(len=256) :: mesg ! Message for error messages. character(len=200) :: filename, chan_file, inputdir ! Strings for file/path integer :: i, j, isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -688,15 +688,15 @@ subroutine reset_face_lengths_file(G, param_file) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB ! These checks apply regardless of the chosen option. - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "CHANNEL_WIDTH_FILE", chan_file, & + call get_param(param_file, mdl, "CHANNEL_WIDTH_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & default="ocean_geometry.nc") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(inputdir)//trim(chan_file) - call log_param(param_file, mod, "INPUTDIR/CHANNEL_WIDTH_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/CHANNEL_WIDTH_FILE", filename) if (is_root_pe()) then ; if (.not.file_exists(filename)) & call MOM_error(FATAL," reset_face_lengths_file: Unable to open "//& @@ -734,7 +734,7 @@ subroutine reset_face_lengths_file(G, param_file) if (G%areaCv(i,J) > 0.0) G%IareaCv(i,J) = G%mask2dCv(i,J) / G%areaCv(i,J) enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine reset_face_lengths_file ! ----------------------------------------------------------------------------- @@ -751,7 +751,7 @@ subroutine reset_face_lengths_list(G, param_file) character(len=120), pointer, dimension(:) :: lines => NULL() character(len=120) :: line character(len=200) :: filename, chan_file, inputdir ! Strings for file/path - character(len=40) :: mod = "reset_face_lengths_list" ! This subroutine's name. + character(len=40) :: mdl = "reset_face_lengths_list" ! This subroutine's name. real, pointer, dimension(:,:) :: & u_lat => NULL(), u_lon => NULL(), v_lat => NULL(), v_lon => NULL() real, pointer, dimension(:) :: & @@ -768,16 +768,16 @@ subroutine reset_face_lengths_list(G, param_file) isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB - call callTree_enter(trim(mod)//"(), MOM_shared_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_shared_initialization.F90") - call get_param(param_file, mod, "CHANNEL_LIST_FILE", chan_file, & + call get_param(param_file, mdl, "CHANNEL_LIST_FILE", chan_file, & "The file from which the list of narrowed channels is read.", & default="MOM_channel_list") - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(inputdir)//trim(chan_file) - call log_param(param_file, mod, "INPUTDIR/CHANNEL_LIST_FILE", filename) - call get_param(param_file, mod, "CHANNEL_LIST_360_LON_CHECK", check_360, & + call log_param(param_file, mdl, "INPUTDIR/CHANNEL_LIST_FILE", filename) + call get_param(param_file, mdl, "CHANNEL_LIST_360_LON_CHECK", check_360, & "If true, the channel configuration list works for any \n"//& "longitudes in the range of -360 to 360.", default=.true.) @@ -941,7 +941,7 @@ subroutine reset_face_lengths_list(G, param_file) deallocate(v_lat) ; deallocate(v_lon) ; deallocate(v_width) endif - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine reset_face_lengths_list ! ----------------------------------------------------------------------------- @@ -1078,7 +1078,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) ! model parameter values. ! (in) directory - The directory into which to place the file. character(len=240) :: filepath - character(len=40) :: mod = "write_ocean_geometry_file" + character(len=40) :: mdl = "write_ocean_geometry_file" integer, parameter :: nFlds=23 type(vardesc) :: vars(nFlds) type(fieldtype) :: fields(nFlds) @@ -1148,7 +1148,7 @@ subroutine write_ocean_geometry_file(G, param_file, directory, geom_file) out_v(:,:) = 0.0 out_q(:,:) = 0.0 - call get_param(param_file, mod, "PARALLEL_RESTARTFILES", multiple_files, & + call get_param(param_file, mdl, "PARALLEL_RESTARTFILES", multiple_files, & "If true, each processor writes its own restart file, \n"//& "otherwise a single restart file is generated", & default=.false.) diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 25222c2b40..5d13bc79d1 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -95,7 +95,7 @@ module MOM_state_initialization public MOM_initialize_state -character(len=40) :: mod = "MOM_state_initialization" ! This module's name. +character(len=40) :: mdl = "MOM_state_initialization" ! This module's name. contains @@ -154,6 +154,9 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & integer :: regrid_iterations logical :: Analytic_FV_PGF, obsol_test logical :: convert + logical :: just_read ! If true, only read the parameters because this + ! is a run from a restart file; this option + ! allows the use of Fatal unused parameters. type(EOS_type), pointer :: eos => NULL() logical :: debug ! indicates whether to write debugging output ! This include declares and sets the variable "version". @@ -167,14 +170,16 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB call callTree_enter("MOM_initialize_state(), MOM_state_initialization.F90") - call log_version(PF, mod, version, "") - call get_param(PF, mod, "DEBUG", debug, default=.false.) + call log_version(PF, mdl, version, "") + call get_param(PF, mdl, "DEBUG", debug, default=.false.) new_sim = .false. if ((dirs%input_filename(1:1) == 'n') .and. & (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. - call get_param(PF, mod, "INPUTDIR", inputdir, & + just_read = .not.new_sim + + call get_param(PF, mdl, "INPUTDIR", inputdir, & "The directory in which input files are found.", default=".") inputdir = slasher(inputdir) @@ -189,225 +194,264 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & !==================================================================== if (new_sim) then -! This block initializes all of the fields internally. ! call MOM_mesg("Run initialized internally.", 3) if (present(Time_in)) Time = Time_in ! Otherwise leave Time at its input value. - call get_param(PF, mod, "INIT_LAYERS_FROM_Z_FILE", from_Z_file, & - "If true, intialize the layer thicknesses, temperatures, \n"//& - "and salnities from a Z-space file on a latitude- \n"//& - "longitude grid.", default=.false.) ! h will be converted from m to H below h(:,:,:) = GV%Angstrom_z + endif - if (from_Z_file) then + ! The remaining initialization calls are done, regardless of whether the + ! fields are actually initialized here (if just_read=.false.) or whether it + ! is just to make sure that all valid parameters are read to enable the + ! detection of unused parameters. + call get_param(PF, mdl, "INIT_LAYERS_FROM_Z_FILE", from_Z_file, & + "If true, intialize the layer thicknesses, temperatures, \n"//& + "and salnities from a Z-space file on a latitude- \n"//& + "longitude grid.", default=.false., do_not_log=just_read) + + if (from_Z_file) then ! Initialize thickness and T/S from z-coordinate data in a file. - if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& - "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") + if (.NOT.use_temperature) call MOM_error(FATAL,"MOM_initialize_state : "//& + "use_temperature must be true if INIT_LAYERS_FROM_Z_FILE is true") - call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) - call pass_var(h, G%Domain) + call MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params=just_read) - else + else ! Initialize thickness, h. - call get_param(PF, mod, "THICKNESS_CONFIG", config, & - "A string that determines how the initial layer \n"//& - "thicknesses are specified for a new run: \n"//& - " \t file - read interface heights from the file specified \n"//& - " \t thickness_file - read thicknesses from the file specified \n"//& - " \t\t by (THICKNESS_FILE).\n"//& - " \t coord - determined by ALE coordinate.\n"//& - " \t uniform - uniform thickness layers evenly distributed \n"//& - " \t\t between the surface and MAXIMUM_DEPTH. \n"//& - " \t DOME - use a slope and channel configuration for the \n"//& - " \t\t DOME sill-overflow test case. \n"//& - " \t ISOMIP - use a configuration for the \n"//& - " \t\t ISOMIP test case. \n"//& - " \t benchmark - use the benchmark test case thicknesses. \n"//& - " \t search - search a density profile for the interface \n"//& - " \t\t densities. This is not yet implemented. \n"//& - " \t circle_obcs - the circle_obcs test case is used. \n"//& - " \t DOME2D - 2D version of DOME initialization. \n"//& - " \t adjustment2d - TBD AJA. \n"//& - " \t sloshing - TBD AJA. \n"//& - " \t seamount - TBD AJA. \n"//& - " \t soliton - Equatorial Rossby soliton. \n"//& - " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& - " \t USER - call a user modified routine.", & - fail_if_missing=.true.) - select case (trim(config)) - case ("file"); call initialize_thickness_from_file(h, G, GV, PF, .false.) - case ("thickness_file"); call initialize_thickness_from_file(h, G, GV, PF, .true.) - case ("coord") - if (useALE) then - call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) - else - call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& - "for THICKNESS_CONFIG of 'coord'") - endif - case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF) - case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF) - case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, PF, tv) - case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, PF, & - tv%eqn_of_state, tv%P_Ref) - case ("search"); call initialize_thickness_search - case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF) - case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, PF) - case ("external_gwave"); call external_gwave_initialize_thickness(h, G, PF) - case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, PF) - case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, PF) - case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, PF) - case ("seamount"); call seamount_initialize_thickness(h, G, GV, PF) - case ("soliton"); call soliton_initialize_thickness(h, G) - case ("phillips"); call Phillips_initialize_thickness(h, G, GV, PF) - case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, PF) - case ("USER"); call user_initialize_thickness(h, G, PF, tv%T) - case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& - "Unrecognized layer thickness configuration "//trim(config)) - end select - call pass_var(h, G%Domain) - -! Initialize temperature and salinity (T and S). - if ( use_temperature ) then - call get_param(PF, mod, "TS_CONFIG", config, & - "A string that determines how the initial tempertures \n"//& - "and salinities are specified for a new run: \n"//& - " \t file - read velocities from the file specified \n"//& - " \t\t by (TS_FILE). \n"//& - " \t fit - find the temperatures that are consistent with \n"//& - " \t\t the layer densities and salinity S_REF. \n"//& - " \t TS_profile - use temperature and salinity profiles \n"//& - " \t\t (read from TS_FILE) to set layer densities. \n"//& - " \t benchmark - use the benchmark test case T & S. \n"//& - " \t linear - linear in logical layer space. \n"//& - " \t DOME2D - 2D DOME initialization. \n"//& - " \t ISOMIP - ISOMIP initialization. \n"//& - " \t adjustment2d - TBD AJA. \n"//& - " \t sloshing - TBD AJA. \n"//& - " \t seamount - TBD AJA. \n"//& - " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& - " \t SCM_ideal_hurr - used in the SCM idealized hurricane test.\n"//& - " \t SCM_CVmix_tests - used in the SCM CVmix tests.\n"//& - " \t USER - call a user modified routine.", & - fail_if_missing=.true.) -! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& - select case (trim(config)) - case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, PF, eos, tv%P_Ref) - case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, PF) - case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & - G, GV, PF, eos, tv%P_Ref) - case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, G, PF) - case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF) - case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, PF, eos) - case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, GV, PF, eos) - case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, PF, eos) - case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & - tv%S, h, G, PF) - case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & - tv%S, h, G, PF, eos) - case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & - tv%S, h, G, GV, PF, eos) - case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & - tv%S, h, G, PF, eos) - case ("SCM_ideal_hurr"); call SCM_idealized_hurricane_TS_init ( tv%T, & - tv%S, h, G, GV, PF) - case ("SCM_CVmix_tests"); call SCM_CVmix_tests_TS_init (tv%T, & - tv%S, h, G, GV, PF) - case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, h) - case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, PF, eos) - case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& - "Unrecognized Temp & salt configuration "//trim(config)) - end select - endif - endif ! not from_Z_file. - -! Initialize velocity components, u and v - call get_param(PF, mod, "VELOCITY_CONFIG", config, & - "A string that determines how the initial velocities \n"//& - "are specified for a new run: \n"//& - " \t file - read velocities from the file specified \n"//& - " \t\t by (VELOCITY_FILE). \n"//& - " \t zero - the fluid is initially at rest. \n"//& - " \t uniform - the flow is uniform (determined by\n"//& - " \t\t parameters INITIAL_U_CONST and INITIAL_V_CONST).\n"//& - " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& - " \t soliton - Equatorial Rossby soliton.\n"//& - " \t USER - call a user modified routine.", default="zero") + call get_param(PF, mdl, "THICKNESS_CONFIG", config, & + "A string that determines how the initial layer \n"//& + "thicknesses are specified for a new run: \n"//& + " \t file - read interface heights from the file specified \n"//& + " \t thickness_file - read thicknesses from the file specified \n"//& + " \t\t by (THICKNESS_FILE).\n"//& + " \t coord - determined by ALE coordinate.\n"//& + " \t uniform - uniform thickness layers evenly distributed \n"//& + " \t\t between the surface and MAXIMUM_DEPTH. \n"//& + " \t DOME - use a slope and channel configuration for the \n"//& + " \t\t DOME sill-overflow test case. \n"//& + " \t ISOMIP - use a configuration for the \n"//& + " \t\t ISOMIP test case. \n"//& + " \t benchmark - use the benchmark test case thicknesses. \n"//& + " \t search - search a density profile for the interface \n"//& + " \t\t densities. This is not yet implemented. \n"//& + " \t circle_obcs - the circle_obcs test case is used. \n"//& + " \t DOME2D - 2D version of DOME initialization. \n"//& + " \t adjustment2d - TBD AJA. \n"//& + " \t sloshing - TBD AJA. \n"//& + " \t seamount - TBD AJA. \n"//& + " \t soliton - Equatorial Rossby soliton. \n"//& + " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& + " \t USER - call a user modified routine.", & + fail_if_missing=new_sim, do_not_log=just_read) select case (trim(config)) - case ("file"); call initialize_velocity_from_file(u, v, G, PF) - case ("zero"); call initialize_velocity_zero(u, v, G, PF) - case ("uniform"); call initialize_velocity_uniform(u, v, G, PF) - case ("circular"); call initialize_velocity_circular(u, v, G, PF) - case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, PF) - case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, G, GV, PF) - case ("soliton"); call soliton_initialize_velocity(u, v, h, G) - case ("USER"); call user_initialize_velocity(u, v, G, PF) + case ("file"); call initialize_thickness_from_file(h, G, GV, PF, .false., just_read_params=just_read) + case ("thickness_file"); call initialize_thickness_from_file(h, G, GV, PF, .true., just_read_params=just_read) + case ("coord") + if (new_sim .and. useALE) then + call ALE_initThicknessToCoord( ALE_CSp, G, GV, h ) + elseif (new_sim) then + call MOM_error(FATAL, "MOM_initialize_state: USE_REGRIDDING must be True "//& + "for THICKNESS_CONFIG of 'coord'") + endif + case ("uniform"); call initialize_thickness_uniform(h, G, GV, PF, & + just_read_params=just_read) + case ("DOME"); call DOME_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("ISOMIP"); call ISOMIP_initialize_thickness(h, G, GV, PF, tv, & + just_read_params=just_read) + case ("benchmark"); call benchmark_initialize_thickness(h, G, GV, PF, & + tv%eqn_of_state, tv%P_Ref, just_read_params=just_read) + case ("search"); call initialize_thickness_search + case ("circle_obcs"); call circle_obcs_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("lock_exchange"); call lock_exchange_initialize_thickness(h, G, GV, & + PF, just_read_params=just_read) + case ("external_gwave"); call external_gwave_initialize_thickness(h, G, & + PF, just_read_params=just_read) + case ("DOME2D"); call DOME2d_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("adjustment2d"); call adjustment_initialize_thickness(h, G, GV, & + PF, just_read_params=just_read) + case ("sloshing"); call sloshing_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("seamount"); call seamount_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("soliton"); call soliton_initialize_thickness(h, G) + case ("phillips"); call Phillips_initialize_thickness(h, G, GV, PF, & + just_read_params=just_read) + case ("rossby_front"); call Rossby_front_initialize_thickness(h, G, GV, & + PF, just_read_params=just_read) + case ("USER"); call user_initialize_thickness(h, G, PF, tv%T, & + just_read_params=just_read) case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& - "Unrecognized velocity configuration "//trim(config)) + "Unrecognized layer thickness configuration "//trim(config)) end select - call pass_vector(u, v, G%Domain) - if (debug) then - call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) +! Initialize temperature and salinity (T and S). + if ( use_temperature ) then + call get_param(PF, mdl, "TS_CONFIG", config, & + "A string that determines how the initial tempertures \n"//& + "and salinities are specified for a new run: \n"//& + " \t file - read velocities from the file specified \n"//& + " \t\t by (TS_FILE). \n"//& + " \t fit - find the temperatures that are consistent with \n"//& + " \t\t the layer densities and salinity S_REF. \n"//& + " \t TS_profile - use temperature and salinity profiles \n"//& + " \t\t (read from TS_FILE) to set layer densities. \n"//& + " \t benchmark - use the benchmark test case T & S. \n"//& + " \t linear - linear in logical layer space. \n"//& + " \t DOME2D - 2D DOME initialization. \n"//& + " \t ISOMIP - ISOMIP initialization. \n"//& + " \t adjustment2d - TBD AJA. \n"//& + " \t sloshing - TBD AJA. \n"//& + " \t seamount - TBD AJA. \n"//& + " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& + " \t SCM_ideal_hurr - used in the SCM idealized hurricane test.\n"//& + " \t SCM_CVmix_tests - used in the SCM CVmix tests.\n"//& + " \t USER - call a user modified routine.", & + fail_if_missing=new_sim, do_not_log=just_read) +! " \t baroclinic_zone - an analytic baroclinic zone. \n"//& + select case (trim(config)) + case ("fit"); call initialize_temp_salt_fit(tv%T, tv%S, G, GV, PF, & + eos, tv%P_Ref, just_read_params=just_read) + case ("file"); call initialize_temp_salt_from_file(tv%T, tv%S, G, & + PF, just_read_params=just_read) + case ("benchmark"); call benchmark_init_temperature_salinity(tv%T, tv%S, & + G, GV, PF, eos, tv%P_Ref, just_read_params=just_read) + case ("TS_profile") ; call initialize_temp_salt_from_profile(tv%T, tv%S, & + G, PF, just_read_params=just_read) + case ("linear"); call initialize_temp_salt_linear(tv%T, tv%S, G, PF, & + just_read_params=just_read) + case ("DOME2D"); call DOME2d_initialize_temperature_salinity ( tv%T, & + tv%S, h, G, PF, eos, just_read_params=just_read) + case ("ISOMIP"); call ISOMIP_initialize_temperature_salinity ( tv%T, & + tv%S, h, G, GV, PF, eos, just_read_params=just_read) + case ("adjustment2d"); call adjustment_initialize_temperature_salinity ( tv%T, & + tv%S, h, G, PF, eos, just_read_params=just_read) + case ("baroclinic_zone"); call baroclinic_zone_init_temperature_salinity( tv%T, & + tv%S, h, G, PF, just_read_params=just_read) + case ("sloshing"); call sloshing_initialize_temperature_salinity(tv%T, & + tv%S, h, G, PF, eos, just_read_params=just_read) + case ("seamount"); call seamount_initialize_temperature_salinity(tv%T, & + tv%S, h, G, GV, PF, eos, just_read_params=just_read) + case ("rossby_front"); call Rossby_front_initialize_temperature_salinity ( tv%T, & + tv%S, h, G, PF, eos, just_read_params=just_read) + case ("SCM_ideal_hurr"); call SCM_idealized_hurricane_TS_init ( tv%T, & + tv%S, h, G, GV, PF, just_read_params=just_read) + case ("SCM_CVmix_tests"); call SCM_CVmix_tests_TS_init (tv%T, & + tv%S, h, G, GV, PF, just_read_params=just_read) + case ("dense"); call dense_water_initialize_TS(G, GV, PF, eos, tv%T, tv%S, & + h, just_read_params=just_read) + case ("USER"); call user_init_temperature_salinity(tv%T, tv%S, G, PF, eos, & + just_read_params=just_read) + case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& + "Unrecognized Temp & salt configuration "//trim(config)) + end select endif + endif ! not from_Z_file. + + ! The thicknesses in halo points might be needed to initialize the velocities. + if (new_sim) call pass_var(h, G%Domain) + +! Initialize velocity components, u and v + call get_param(PF, mdl, "VELOCITY_CONFIG", config, & + "A string that determines how the initial velocities \n"//& + "are specified for a new run: \n"//& + " \t file - read velocities from the file specified \n"//& + " \t\t by (VELOCITY_FILE). \n"//& + " \t zero - the fluid is initially at rest. \n"//& + " \t uniform - the flow is uniform (determined by\n"//& + " \t\t parameters INITIAL_U_CONST and INITIAL_V_CONST).\n"//& + " \t rossby_front - a mixed layer front in thermal wind balance.\n"//& + " \t soliton - Equatorial Rossby soliton.\n"//& + " \t USER - call a user modified routine.", default="zero", & + do_not_log=just_read) + select case (trim(config)) + case ("file"); call initialize_velocity_from_file(u, v, G, PF, & + just_read_params=just_read) + case ("zero"); call initialize_velocity_zero(u, v, G, PF, & + just_read_params=just_read) + case ("uniform"); call initialize_velocity_uniform(u, v, G, PF, & + just_read_params=just_read) + case ("circular"); call initialize_velocity_circular(u, v, G, PF, & + just_read_params=just_read) + case ("phillips"); call Phillips_initialize_velocity(u, v, G, GV, PF, & + just_read_params=just_read) + case ("rossby_front"); call Rossby_front_initialize_velocity(u, v, h, & + G, GV, PF, just_read_params=just_read) + case ("soliton"); call soliton_initialize_velocity(u, v, h, G) + case ("USER"); call user_initialize_velocity(u, v, G, PF, & + just_read_params=just_read) + case default ; call MOM_error(FATAL, "MOM_initialize_state: "//& + "Unrecognized velocity configuration "//trim(config)) + end select + + if (new_sim) call pass_vector(u, v, G%Domain) + if (debug .and. new_sim) then + call uvchksum("MOM_initialize_state [uv]", u, v, G%HI, haloshift=1) + endif ! Optionally convert the thicknesses from m to kg m-2. This is particularly ! useful in a non-Boussinesq model. - call get_param(PF, mod, "CONVERT_THICKNESS_UNITS", convert, & - "If true, convert the thickness initial conditions from \n"//& - "units of m to kg m-2 or vice versa, depending on whether \n"//& - "BOUSSINESQ is defined. This does not apply if a restart \n"//& - "file is read.", default=.false.) + call get_param(PF, mdl, "CONVERT_THICKNESS_UNITS", convert, & + "If true, convert the thickness initial conditions from \n"//& + "units of m to kg m-2 or vice versa, depending on whether \n"//& + "BOUSSINESQ is defined. This does not apply if a restart \n"//& + "file is read.", default=.false., do_not_log=just_read) + if (new_sim) then if (convert .and. .not. GV%Boussinesq) then ! Convert h from m to kg m-2 then to thickness units (H) - call convert_thickness(h, G, GV, PF, tv) + call convert_thickness(h, G, GV, tv) elseif (GV%Boussinesq) then ! Convert h from m to thickness units (H) h(:,:,:) = h(:,:,:)*GV%m_to_H else h(:,:,:) = h(:,:,:)*GV%kg_m2_to_H endif + endif ! Remove the mass that would be displaced by an ice shelf or inverse barometer. - call get_param(PF, mod, "DEPRESS_INITIAL_SURFACE", depress_sfc, & - "If true, depress the initial surface to avoid huge \n"//& - "tsunamis when a large surface pressure is applied.", & - default=.false.) - call get_param(PF, mod, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & - "If true, cuts way the top of the column for initial conditions\n"//& - "at the depth where the hydrostatic presure matches the imposed\n"//& - "surface pressure which is read from file.", default=.false.) - if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& - "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") - if (depress_sfc) call depress_surface(h, G, GV, PF, tv) - if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h) - - ! Perhaps we want to run the regridding coordinate generator for multiple - ! iterations here so the initial grid is consistent with the coordinate - if (useALE) then - call get_param(PF, mod, "REGRID_ACCELERATE_INIT", regrid_accelerate, & - "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding\n"//& - "algorithm to push the initial grid to be consistent with the initial\n"//& - "condition. Useful only for state-based and iterative coordinates.", & - default=.false.) - if (regrid_accelerate) then - call get_param(PF, mod, "REGRID_ACCELERATE_ITERATIONS", regrid_iterations, & - "The number of regridding iterations to perform to generate\n"//& - "an initial grid that is consistent with the initial conditions.", & - default=1) - + call get_param(PF, mdl, "DEPRESS_INITIAL_SURFACE", depress_sfc, & + "If true, depress the initial surface to avoid huge \n"//& + "tsunamis when a large surface pressure is applied.", & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "TRIM_IC_FOR_P_SURF", trim_ic_for_p_surf, & + "If true, cuts way the top of the column for initial conditions\n"//& + "at the depth where the hydrostatic presure matches the imposed\n"//& + "surface pressure which is read from file.", default=.false., & + do_not_log=just_read) + if (depress_sfc .and. trim_ic_for_p_surf) call MOM_error(FATAL, "MOM_initialize_state: "//& + "DEPRESS_INITIAL_SURFACE and TRIM_IC_FOR_P_SURF are exclusive and cannot both be True") + if (depress_sfc) call depress_surface(h, G, GV, PF, tv, just_read_params=just_read) + if (trim_ic_for_p_surf) call trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params=just_read) + + ! Perhaps we want to run the regridding coordinate generator for multiple + ! iterations here so the initial grid is consistent with the coordinate + if (useALE) then + call get_param(PF, mdl, "REGRID_ACCELERATE_INIT", regrid_accelerate, & + "If true, runs REGRID_ACCELERATE_ITERATIONS iterations of the regridding\n"//& + "algorithm to push the initial grid to be consistent with the initial\n"//& + "condition. Useful only for state-based and iterative coordinates.", & + default=.false., do_not_log=just_read) + if (regrid_accelerate) then + call get_param(PF, mdl, "REGRID_ACCELERATE_ITERATIONS", regrid_iterations, & + "The number of regridding iterations to perform to generate\n"//& + "an initial grid that is consistent with the initial conditions.", & + default=1, do_not_log=just_read) + + if (new_sim) & call ALE_regrid_accelerated(ALE_CSp, G, GV, h, tv, regrid_iterations, h, u, v) - endif endif + endif + ! This is the end of the block of code that might have initialized fields + ! internally at the start of a new run. - else ! Previous block for new_sim=.T., this block restores state -! This line calls a subroutine that reads the initial conditions ! -! from a previously generated file. ! + if (.not.new_sim) then ! This block restores the state from a restart file. + ! This line calls a subroutine that reads the initial conditions ! + ! from a previously generated file. ! call restore_state(dirs%input_filename, dirs%restart_input_dir, Time, & G, restart_CS) if (present(Time_in)) Time = Time_in @@ -425,16 +469,12 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & if ( use_temperature ) call hchksum(tv%S, "MOM_initialize_state: S ", G%HI, haloshift=1) endif - call get_param(PF, mod, "SPONGE", use_sponge, & + call get_param(PF, mdl, "SPONGE", use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified via SPONGE_CONFIG.", default=.false.) if ( use_sponge ) then -! The 3 arguments here are (1) a flag indicating whether the sponge ! -! values are to be read from files, (2) the name of a file containing! -! the state toward which the model is damped, and (3) the file in ! -! which the 2-D damping rate field can be found. ! - call get_param(PF, mod, "SPONGE_CONFIG", config, & + call get_param(PF, mdl, "SPONGE_CONFIG", config, & "A string that sets how the sponges are configured: \n"//& " \t file - read sponge properties from the file \n"//& " \t\t specified by (SPONGE_FILE).\n"//& @@ -470,7 +510,7 @@ subroutine MOM_initialize_state(u, v, h, tv, Time, G, GV, PF, dirs, & ! This controls user code for setting open boundary data if (associated(OBC)) then - call get_param(PF, mod, "OBC_USER_CONFIG", config, & + call get_param(PF, mdl, "OBC_USER_CONFIG", config, & "A string that sets how the user code is invoked to set open\n"//& " boundary data: \n"//& " DOME - specified inflow on northern boundary\n"//& @@ -516,12 +556,20 @@ end subroutine MOM_initialize_state ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickness) - 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(out) :: h !< Layer thicknesses, in m - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - logical, intent(in) :: file_has_thickness +!> This subroutine reads the layer thicknesses or interface heights from a file. +subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickness, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, intent(in) :: file_has_thickness !< If true, this file contains layer + !! thicknesses; otherwise it contains + !! interface heights. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Arguments: h - The thickness that is being initialized. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -536,32 +584,39 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne real :: dilate ! The amount by which each layer is dilated to agree ! with the bottom depth and free surface height, nondim. logical :: correct_thickness - character(len=40) :: mod = "initialize_thickness_from_file" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate + character(len=40) :: mdl = "initialize_thickness_from_file" ! This subroutine's name. character(len=200) :: filename, thickness_file, inputdir, mesg ! Strings for file/path integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + if (.not.just_read) & + call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".", do_not_log=just_read) inputdir = slasher(inputdir) - call get_param(param_file, mod, "THICKNESS_FILE", thickness_file, & - "The name of the thickness file.", fail_if_missing=.true.) + call get_param(param_file, mdl, "THICKNESS_FILE", thickness_file, & + "The name of the thickness file.", & + fail_if_missing=.not.just_read, do_not_log=just_read) filename = trim(inputdir)//trim(thickness_file) - call log_param(param_file, mod, "INPUTDIR/THICKNESS_FILE", filename) + if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/THICKNESS_FILE", filename) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & + if ((.not.just_read) .and. (.not.file_exists(filename, G%Domain))) call MOM_error(FATAL, & " initialize_thickness_from_file: Unable to open "//trim(filename)) if (file_has_thickness) then + if (just_read) return ! All run-time parameters have been read, so return. call read_data(filename,"h",h(:,:,:),domain=G%Domain%mpp_domain) else - call get_param(param_file, mod, "ADJUST_THICKNESS", correct_thickness, & + call get_param(param_file, mdl, "ADJUST_THICKNESS", correct_thickness, & "If true, all mass below the bottom removed if the \n"//& "topography is shallower than the thickness input file \n"//& - "would indicate.", default=.false.) + "would indicate.", default=.false., do_not_log=just_read) + if (just_read) return ! All run-time parameters have been read, so return. call read_data(filename,"eta",eta(:,:,:),domain=G%Domain%mpp_domain) @@ -591,7 +646,7 @@ subroutine initialize_thickness_from_file(h, G, GV, param_file, file_has_thickne endif endif - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_thickness_from_file ! ----------------------------------------------------------------------------- @@ -671,11 +726,15 @@ end subroutine adjustEtaToFitBathymetry ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_thickness_uniform(h, G, GV, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: h !< Layer thicknesses, in m - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters +subroutine initialize_thickness_uniform(h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: h - The thickness that is being initialized. ! (in) G - The ocean's grid structure. @@ -684,16 +743,21 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file) ! model parameter values. ! This subroutine initializes the layer thicknesses to be uniform. - character(len=40) :: mod = "initialize_thickness_uniform" ! This subroutine's name. + character(len=40) :: mdl = "initialize_thickness_uniform" ! This subroutine's name. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! This subroutine has no run-time parameters. + + call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") if (G%max_depth<=0.) call MOM_error(FATAL,"initialize_thickness_uniform: "// & "MAXIMUM_DEPTH has a non-sensical value! Was it set?") @@ -720,7 +784,7 @@ subroutine initialize_thickness_uniform(h, G, GV, param_file) enddo enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_thickness_uniform ! ----------------------------------------------------------------------------- @@ -731,17 +795,14 @@ subroutine initialize_thickness_search end subroutine initialize_thickness_search ! ----------------------------------------------------------------------------- -subroutine convert_thickness(h, G, GV, param_file, tv) +subroutine convert_thickness(h, G, GV, tv) 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(inout) :: h !< Layer thicknesses, being converted from m to H (m or kg m-2) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables ! Arguments: h - The thickness that is being initialized. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. -! (in) param_file - A structure indicating the open file to parse for -! model parameter values. real, dimension(SZI_(G),SZJ_(G)) :: & p_top, p_bot real :: dz_geo(SZI_(G),SZJ_(G)) ! The change in geopotential height @@ -803,12 +864,15 @@ subroutine convert_thickness(h, G, GV, param_file, tv) end subroutine convert_thickness -subroutine depress_surface(h, G, GV, param_file, tv) - 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(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables +subroutine depress_surface(h, G, GV, param_file, tv, just_read_params) + 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(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: h - The thickness that is being initialized. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -822,29 +886,36 @@ subroutine depress_surface(h, G, GV, param_file, tv) real :: dilate ! A ratio by which layers are dilated, nondim. real :: scale_factor ! A scaling factor for the eta_sfc values that are read ! in, which can be used to change units, for example. - character(len=40) :: mod = "depress_surface" ! This subroutine's name. + character(len=40) :: mdl = "depress_surface" ! This subroutine's name. character(len=200) :: inputdir, eta_srf_file ! Strings for file/path character(len=200) :: filename, eta_srf_var ! Strings for file/path + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + ! Read the surface height (or pressure) from a file. - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_FILE", eta_srf_file,& "The initial condition file for the surface height.", & - fail_if_missing=.true.) - call get_param(param_file, mod, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_VAR", eta_srf_var, & "The initial condition variable for the surface height.",& - default="SSH") + default="SSH", do_not_log=just_read) filename = trim(inputdir)//trim(eta_srf_file) - call log_param(param_file, mod, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + if (.not.just_read) & + call log_param(param_file, mdl, "INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) - call read_data(filename,eta_srf_var,eta_sfc,domain=G%Domain%mpp_domain) - call get_param(param_file, mod, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & + call get_param(param_file, mdl, "SURFACE_HEIGHT_IC_SCALE", scale_factor, & "A scaling factor to convert SURFACE_HEIGHT_IC_VAR into \n"//& - "units of m", units="variable", default=1.0) + "units of m", units="variable", default=1.0, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + + call read_data(filename,eta_srf_var,eta_sfc,domain=G%Domain%mpp_domain) if (scale_factor /= 1.0) then ; do j=js,je ; do i=is,ie eta_sfc(i,j) = eta_sfc(i,j) * scale_factor @@ -885,45 +956,56 @@ end subroutine depress_surface !> Adjust the layer thicknesses by cutting away the top of each model column at the depth !! where the hydrostatic pressure matches an imposed surface pressure read from file. -subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h) - type(param_file_type), intent(in) :: PF !< Parameter file structure - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - type(ALE_CS), pointer :: ALE_CSp !< ALE control structure - type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units, m or Pa) +subroutine trim_for_ice(PF, G, GV, ALE_CSp, tv, h, just_read_params) + type(param_file_type), intent(in) :: PF !< Parameter file structure + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + type(ALE_CS), pointer :: ALE_CSp !< ALE control structure + type(thermo_var_ptrs), intent(inout) :: tv !< Thermodynamics structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(inout) :: h !< Layer thickness (H units, m or Pa) + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables - character(len=200) :: mod = "trim_for_ice" + character(len=200) :: mdl = "trim_for_ice" real, dimension(SZI_(G),SZJ_(G)) :: p_surf ! Imposed pressure on ocean at surface (Pa) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: S_t, S_b, T_t, T_b ! Top and bottom edge values for reconstructions ! of salinity and temperature within each layer. character(len=200) :: inputdir, filename, p_surf_file, p_surf_var ! Strings for file/path real :: scale_factor, min_thickness integer :: i, j, k + logical :: just_read ! If true, just read parameters but set nothing. logical :: use_remapping type(remapping_CS), pointer :: remap_CS => NULL() - call get_param(PF, mod, "SURFACE_PRESSURE_FILE", p_surf_file, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(PF, mdl, "SURFACE_PRESSURE_FILE", p_surf_file, & "The initial condition file for the surface height.", & - fail_if_missing=.true.) - call get_param(PF, mod, "SURFACE_PRESSURE_VAR", p_surf_var, & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(PF, mdl, "SURFACE_PRESSURE_VAR", p_surf_var, & "The initial condition variable for the surface height.", & - units="kg m-2", default="") - call get_param(PF, mod, "INPUTDIR", inputdir, default=".", do_not_log=.true.) + units="kg m-2", default="", do_not_log=just_read) + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".", do_not_log=.true.) filename = trim(slasher(inputdir))//trim(p_surf_file) - call log_param(PF, mod, "!INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) + if (.not.just_read) call log_param(PF, mdl, "!INPUTDIR/SURFACE_HEIGHT_IC_FILE", filename) - call read_data(filename, p_surf_var, p_surf, domain=G%Domain%mpp_domain) - call get_param(PF, mod, "SURFACE_PRESSURE_SCALE", scale_factor, & + call get_param(PF, mdl, "SURFACE_PRESSURE_SCALE", scale_factor, & "A scaling factor to convert SURFACE_PRESSURE_VAR from\n"//& "file SURFACE_PRESSURE_FILE into a surface pressure.", & - units="file dependent", default=1.) - if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:) - call get_param(PF, mod, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & - units='m', default=1.e-3) - call get_param(PF, mod, "TRIMMING_USES_REMAPPING", use_remapping, & + units="file dependent", default=1., do_not_log=just_read) + call get_param(PF, mdl, "MIN_THICKNESS", min_thickness, 'Minimum layer thickness', & + units='m', default=1.e-3, do_not_log=just_read) + call get_param(PF, mdl, "TRIMMING_USES_REMAPPING", use_remapping, & 'When trimming the column, also remap T and S.', & - default=.false.) + default=.false., do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + + call read_data(filename, p_surf_var, p_surf, domain=G%Domain%mpp_domain) + if (scale_factor /= 1.) p_surf(:,:) = scale_factor * p_surf(:,:) + if (use_remapping) then allocate(remap_CS) call initialize_remapping(remap_CS, 'PLM', boundary_extrapolation=.true.) @@ -1035,30 +1117,38 @@ subroutine cut_off_column_top(nk, tv, Rho0, G_earth, depth, min_thickness, & end subroutine cut_off_column_top ! ----------------------------------------------------------------------------- -subroutine initialize_velocity_from_file(u, v, G, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure +subroutine initialize_velocity_from_file(u, v, G, param_file, just_read_params) + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for modelparameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: u - The zonal velocity that is being initialized. ! (out) v - The meridional velocity that is being initialized. ! (in) G - The ocean's grid structure. ! (in) param_file - parameter file type ! This subroutine reads the initial velocity components from file - character(len=40) :: mod = "initialize_velocity_from_file" ! This subroutine's name. + character(len=40) :: mdl = "initialize_velocity_from_file" ! This subroutine's name. character(len=200) :: filename,velocity_file,inputdir ! Strings for file/path + logical :: just_read ! If true, just read parameters but set nothing. + + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") - call get_param(param_file, mod, "VELOCITY_FILE", velocity_file, & + call get_param(param_file, mdl, "VELOCITY_FILE", velocity_file, & "The name of the velocity initial condition file.", & - fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) + if (just_read) return ! All run-time parameters have been read, so return. + filename = trim(inputdir)//trim(velocity_file) - call log_param(param_file, mod, "INPUTDIR/VELOCITY_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/VELOCITY_FILE", filename) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_velocity_from_file: Unable to open "//trim(filename)) @@ -1067,28 +1157,36 @@ subroutine initialize_velocity_from_file(u, v, G, param_file) call read_data(filename,"u",u(:,:,:),domain=G%Domain%mpp_domain,position=EAST_FACE) call read_data(filename,"v",v(:,:,:),domain=G%Domain%mpp_domain,position=NORTH_FACE) - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_from_file ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_velocity_zero(u, v, G, param_file) +subroutine initialize_velocity_zero(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for modelparameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: u - The zonal velocity that is being initialized. ! (out) v - The meridional velocity that is being initialized. ! (in) G - The ocean's grid structure. ! (in) param_file - parameter file type ! This subroutine sets the initial velocity components to zero - character(len=200) :: mod = "initialize_velocity_zero" ! This subroutine's name. + character(len=200) :: mdl = "initialize_velocity_zero" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + + if (just_read) return ! All run-time parameters have been read, so return. do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = 0.0 @@ -1097,16 +1195,19 @@ subroutine initialize_velocity_zero(u, v, G, param_file) v(i,J,k) = 0.0 enddo ; enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_velocity_zero ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_velocity_uniform(u, v, G, param_file) +subroutine initialize_velocity_uniform(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for modelparameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: u - The zonal velocity that is being initialized. ! (out) v - The meridional velocity that is being initialized. ! (in) G - The ocean's grid structure. @@ -1115,16 +1216,21 @@ subroutine initialize_velocity_uniform(u, v, G, param_file) ! This subroutine sets the initial velocity components to uniform integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz real :: initial_u_const, initial_v_const - character(len=200) :: mod = "initialize_velocity_uniform" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=200) :: mdl = "initialize_velocity_uniform" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - call get_param(param_file, mod, "INITIAL_U_CONST", initial_u_const, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl, "INITIAL_U_CONST", initial_u_const, & "A initial uniform value for the zonal flow.", & - units="m s-1", fail_if_missing=.true.) - call get_param(param_file, mod, "INITIAL_V_CONST", initial_v_const, & + units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "INITIAL_V_CONST", initial_v_const, & "A initial uniform value for the meridional flow.", & - units="m s-1", fail_if_missing=.true.) + units="m s-1", fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. do k=1,nz ; do j=js,je ; do I=Isq,Ieq u(I,j,k) = initial_u_const @@ -1137,11 +1243,14 @@ end subroutine initialize_velocity_uniform ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_velocity_circular(u, v, G, param_file) +subroutine initialize_velocity_circular(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZIB_(G),SZJ_(G), SZK_(G)), intent(out) :: u !< The zonal velocity that is being initialized, in m s-1 real, dimension(SZI_(G),SZJB_(G), SZK_(G)), intent(out) :: v !< The meridional velocity that is being initialized, in m s-1 - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for modelparameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Arguments: u - The zonal velocity that is being initialized. ! (out) v - The meridional velocity that is being initialized. ! (in) G - The ocean's grid structure. @@ -1149,17 +1258,23 @@ subroutine initialize_velocity_circular(u, v, G, param_file) ! This subroutine sets the initial velocity components to be circular with ! no flow at edges of domain and center. - character(len=200) :: mod = "initialize_velocity_circular" + character(len=200) :: mdl = "initialize_velocity_circular" real :: circular_max_u real :: dpi, psi1, psi2 + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB - call get_param(param_file, mod, "CIRCULAR_MAX_U", circular_max_u, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl, "CIRCULAR_MAX_U", circular_max_u, & "The amplitude of zonal flow from which to scale the\n"// & "circular stream function (m/s).", & - units="m s-1", default=0.) + units="m s-1", default=0., do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + dpi=acos(0.0)*2.0 ! pi do k=1,nz ; do j=js,je ; do I=Isq,Ieq @@ -1190,10 +1305,12 @@ end subroutine initialize_velocity_circular ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_temp_salt_from_file(T, S, G, param_file) +subroutine initialize_temp_salt_from_file(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! This function puts the initial layer temperatures and salinities ! ! into T(:,:,:) and S(:,:,:). ! @@ -1205,49 +1322,59 @@ subroutine initialize_temp_salt_from_file(T, S, G, param_file) ! (in) G - The ocean's grid structure. ! (in) param_file - A structure indicating the open file to parse for ! model parameter values. - character(len=200) :: filename, ts_file, salt_file, inputdir ! Strings for file/path - character(len=40) :: mod = "initialize_temp_salt_from_file" - character(len=64) :: temp_var, salt_var + logical :: just_read ! If true, just read parameters but set nothing. + character(len=200) :: filename, salt_filename ! Full paths to input files + character(len=200) :: ts_file, salt_file, inputdir ! Strings for file/path + character(len=40) :: mdl = "initialize_temp_salt_from_file" + character(len=64) :: temp_var, salt_var ! Temperature and salinity names in files - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mod, "TS_FILE", ts_file, & + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + + call get_param(param_file, mdl, "TS_FILE", ts_file, & "The initial condition file for temperature.", & - fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(inputdir)//trim(ts_file) - call log_param(param_file, mod, "INPUTDIR/TS_FILE", filename) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & - " initialize_temp_salt_from_file: Unable to open "//trim(filename)) - - call get_param(param_file, mod, "TEMP_IC_VAR", temp_var, & + if (.not.just_read) call log_param(param_file, mdl, "INPUTDIR/TS_FILE", filename) + call get_param(param_file, mdl, "TEMP_IC_VAR", temp_var, & "The initial condition variable for potential temperature.", & - default="PTEMP") - call get_param(param_file, mod, "SALT_IC_VAR", salt_var, & - "The initial condition variable for salinity.", default="SALT") + default="PTEMP", do_not_log=just_read) + call get_param(param_file, mdl, "SALT_IC_VAR", salt_var, & + "The initial condition variable for salinity.", & + default="SALT", do_not_log=just_read) + call get_param(param_file, mdl, "SALT_FILE", salt_file, & + "The initial condition file for salinity.", & + default=trim(ts_file), do_not_log=just_read) -! Read the temperatures and salinities from a netcdf file. ! - call read_data(filename, temp_var, T(:,:,:), domain=G%Domain%mpp_domain) + if (just_read) return ! All run-time parameters have been read, so return. - call get_param(param_file, mod, "SALT_FILE", salt_file, & - "The initial condition file for salinity.", default=trim(ts_file)) - filename = trim(inputdir)//trim(ts_file) if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & " initialize_temp_salt_from_file: Unable to open "//trim(filename)) - call read_data(filename, salt_var, S(:,:,:), domain=G%Domain%mpp_domain) +! Read the temperatures and salinities from netcdf files. ! + call read_data(filename, temp_var, T(:,:,:), domain=G%Domain%mpp_domain) + + salt_filename = trim(inputdir)//trim(salt_file) + if (.not.file_exists(salt_filename, G%Domain)) call MOM_error(FATAL, & + " initialize_temp_salt_from_file: Unable to open "//trim(salt_filename)) - call callTree_leave(trim(mod)//'()') + call read_data(salt_filename, salt_var, S(:,:,:), domain=G%Domain%mpp_domain) + + call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_from_file ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_temp_salt_from_profile(T, S, G, param_file) +subroutine initialize_temp_salt_from_profile(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! This function puts the initial layer temperatures and salinities ! ! into T(:,:,:) and S(:,:,:). ! @@ -1261,18 +1388,24 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file) ! model parameter values. real, dimension(SZK_(G)) :: T0, S0 integer :: i, j, k + logical :: just_read ! If true, just read parameters but set nothing. character(len=200) :: filename, ts_file, inputdir ! Strings for file/path - character(len=40) :: mod = "initialize_temp_salt_from_profile" + character(len=40) :: mdl = "initialize_temp_salt_from_profile" + + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") - call get_param(param_file, mod, "TS_FILE", ts_file, & + call get_param(param_file, mdl, "TS_FILE", ts_file, & "The file with the reference profiles for temperature \n"//& - "and salinity.", fail_if_missing=.true.) - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + "and salinity.", fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(inputdir)//trim(ts_file) - call log_param(param_file, mod, "INPUTDIR/TS_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/TS_FILE", filename) if (.not.file_exists(filename)) call MOM_error(FATAL, & " initialize_temp_salt_from_profile: Unable to open "//trim(filename)) @@ -1284,19 +1417,21 @@ subroutine initialize_temp_salt_from_profile(T, S, G, param_file) T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) enddo ; enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_from_profile ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref) +subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref, just_read_params) 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(out) :: T, S type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters type(EOS_type), pointer :: eqn_of_state real, intent(in) :: P_Ref + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! This function puts the initial layer temperatures and salinities ! ! into T(:,:,:) and S(:,:,:). ! @@ -1316,22 +1451,28 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref real :: drho_dS(SZK_(G)) ! Derivative of density with salinity in kg m-3 PSU-1. ! real :: rho_guess(SZK_(G)) ! Potential density at T0 & S0 in kg m-3. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. - character(len=40) :: mod = "initialize_temp_salt_fit" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "initialize_temp_salt_fit" ! This subroutine's name. integer :: i, j, k, itt, nz nz = G%ke - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mod, "T_REF", T_Ref, & + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + + call get_param(param_file, mdl, "T_REF", T_Ref, & "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.true.) - call get_param(param_file, mod, "S_REF", S_Ref, & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_Ref, & "A reference salinity used in initialization.", units="PSU", & - default=35.0) - call get_param(param_file, mod, "FIT_SALINITY", fit_salin, & + default=35.0, do_not_log=just_read) + call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & "If true, accept the prescribed temperature and fit the \n"//& "salinity; otherwise take salinity and fit temperature.", & - default=.false.) + default=.false., do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + do k=1,nz pres(k) = P_Ref ; S0(k) = S_Ref T0(k) = T_Ref @@ -1371,15 +1512,18 @@ subroutine initialize_temp_salt_fit(T, S, G, GV, param_file, eqn_of_state, P_Ref T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) enddo ; enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_fit ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine initialize_temp_salt_linear(T, S, G, param_file) +subroutine initialize_temp_salt_linear(T, S, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T, S type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! This subroutine initializes linear profiles for T and S according to ! reference surface layer salinity and temperature and a specified range. ! Note that the linear distribution is set up with respect to the layer @@ -1389,21 +1533,26 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file) real :: S_top, T_top ! Reference salinity and temerature within surface layer real :: S_range, T_range ! Range of salinities and temperatures over the vertical real :: delta - character(len=40) :: mod = "initialize_temp_salt_linear" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's name. - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") - call get_param(param_file, mod, "T_TOP", T_top, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + call get_param(param_file, mdl, "T_TOP", T_top, & "Initial temperature of the top surface.", & - units="degC", fail_if_missing=.true.) - call get_param(param_file, mod, "T_RANGE", T_range, & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "T_RANGE", T_range, & "Initial temperature difference (top-bottom).", & - units="degC", fail_if_missing=.true.) - call get_param(param_file, mod, "S_TOP", S_top, & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_TOP", S_top, & "Initial salinity of the top surface.", & - units="PSU", fail_if_missing=.true.) - call get_param(param_file, mod, "S_RANGE", S_range, & + units="PSU", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_RANGE", S_range, & "Initial salinity difference (top-bottom).", & - units="PSU", fail_if_missing=.true.) + units="PSU", fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. ! ! Prescribe salinity ! delta_S = S_range / ( G%ke - 1.0 ); @@ -1425,7 +1574,7 @@ subroutine initialize_temp_salt_linear(T, S, G, param_file) ! delta = 1; ! T(:,:,G%ke/2 - (delta-1):G%ke/2 + delta) = 1.0; - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') end subroutine initialize_temp_salt_linear ! ----------------------------------------------------------------------------- @@ -1471,37 +1620,37 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp) integer :: i, j, k, is, ie, js, je, nz character(len=40) :: potemp_var, salin_var, Idamp_var, eta_var - character(len=40) :: mod = "initialize_sponges_file" + character(len=40) :: mdl = "initialize_sponges_file" character(len=200) :: damping_file, state_file ! Strings for filenames character(len=200) :: filename, inputdir ! Strings for file/path and path. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pres(:) = 0.0 ; eta(:,:,:) = 0.0 ; tmp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) - call get_param(param_file, mod, "SPONGE_DAMPING_FILE", damping_file, & + call get_param(param_file, mdl, "SPONGE_DAMPING_FILE", damping_file, & "The name of the file with the sponge damping rates.", & fail_if_missing=.true.) - call get_param(param_file, mod, "SPONGE_STATE_FILE", state_file, & + call get_param(param_file, mdl, "SPONGE_STATE_FILE", state_file, & "The name of the file with the state to damp toward.", & default=damping_file) - call get_param(param_file, mod, "SPONGE_PTEMP_VAR", potemp_var, & + call get_param(param_file, mdl, "SPONGE_PTEMP_VAR", potemp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="PTEMP") - call get_param(param_file, mod, "SPONGE_SALT_VAR", salin_var, & + call get_param(param_file, mdl, "SPONGE_SALT_VAR", salin_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="SALT") - call get_param(param_file, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(param_file, mdl, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="ETA") - call get_param(param_file, mod, "SPONGE_IDAMP_VAR", Idamp_var, & + call get_param(param_file, mdl, "SPONGE_IDAMP_VAR", Idamp_var, & "The name of the inverse damping rate variable in \n"//& "SPONGE_DAMPING_FILE.", default="IDAMP") filename = trim(inputdir)//trim(damping_file) - call log_param(param_file, mod, "INPUTDIR/SPONGE_DAMPING_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/SPONGE_DAMPING_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename)) @@ -1513,7 +1662,7 @@ subroutine initialize_sponges_file(G, GV, use_temperature, tv, param_file, CSp) ! momentum is typically not damped within the sponge. ! filename = trim(inputdir)//trim(state_file) - call log_param(param_file, mod, "INPUTDIR/SPONGE_STATE_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/SPONGE_STATE_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_sponges: Unable to open "//trim(filename)) @@ -1619,14 +1768,11 @@ end subroutine set_velocity_depth_min ! ----------------------------------------------------------------------------- ! ----------------------------------------------------------------------------- -subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) - -! Determines the isopycnal interfaces and layer potential -! temperatures and salinities directly from a z-space file on a latitude- -! longitude grid. -! -! This subroutine was written by M. Harrison, with input from R. Hallberg. -! and A. Adcroft. +!> This subroutine determines the isopycnal or other coordinate interfaces and +!! layer potential temperatures and salinities directly from a z-space file on +!! a latitude-longitude grid. +subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, just_read_params) +! This subroutine was written by M. Harrison, with input from R. Hallberg & A. Adcroft. ! ! Arguments: ! (out) h - Layer thickness, in m. @@ -1637,14 +1783,17 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) ! (in) GV - The ocean's vertical grid structure. ! (in) PF - A structure indicating the open file to parse for ! model parameter values. -! (in) dirs - A structure containing several relevant directory paths. - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(out) :: h !< Layer thicknesses, in m - type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic variables - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: PF - type(directories), intent(in) :: dirs + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(out) :: h !< Layer thicknesses being initialized, in m + type(thermo_var_ptrs), intent(inout) :: tv !< A structure pointing to various thermodynamic + !! variables including temperature and salinity + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(param_file_type), intent(in) :: PF !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. character(len=200) :: filename ! The name of an input file containing temperature ! and salinity in z-space; also used for ice shelf area. @@ -1652,14 +1801,15 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) ! in z-space. character(len=200) :: sfilename ! The name of an input file containing only salinity ! in z-space. - character(len=200) :: inputdir ! The directory where NetCDF input files are. + character(len=200) :: shelf_file ! The name of an input file used for ice shelf area. + character(len=200) :: inputdir ! The directory where NetCDF input filesare. character(len=200) :: mesg, area_varname, ice_shelf_file type(EOS_type), pointer :: eos => NULL() ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_initialize_layers_from_Z" ! This module's name. + character(len=40) :: mdl = "MOM_initialize_layers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices integer :: isc,iec,jsc,jec ! global compute domain indices @@ -1677,19 +1827,18 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) real :: min_depth real :: dilate real :: missing_value_temp, missing_value_salt - logical :: new_sim logical :: correct_thickness character(len=40) :: potemp_var, salin_var character(len=8) :: laynum integer, parameter :: niter=10 ! number of iterations for t/s adjustment to layer density + logical :: just_read ! If true, just read parameters but set nothing. logical :: adjust_temperature = .true. ! fit t/s to target densities real, parameter :: missing_value = -1.e20 real, parameter :: temp_land_fill = 0.0, salt_land_fill = 35.0 logical :: reentrant_x, tripolar_n,dbg logical :: debug = .false. ! manually set this to true for verbose output - !data arrays real, dimension(:), allocatable :: z_edges_in, z_in, Rb real, dimension(:,:,:), allocatable, target :: temp_z, salt_z, mask_z @@ -1726,68 +1875,93 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) PI_180=atan(1.0)/45. - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") - call log_version(PF, mod, version, "") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - new_sim = .false. - if ((dirs%input_filename(1:1) == 'n') .and. & - (LEN_TRIM(dirs%input_filename) == 1)) new_sim = .true. + if (.not.just_read) call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") + if (.not.just_read) call log_version(PF, mdl, version, "") - inputdir = "." ; call get_param(PF, mod, "INPUTDIR", inputdir) + inputdir = "." ; call get_param(PF, mdl, "INPUTDIR", inputdir) inputdir = slasher(inputdir) eos => tv%eqn_of_state ! call mpp_get_compute_domain(G%domain%mpp_domain,isc,iec,jsc,jec) - reentrant_x = .false. ; call get_param(PF, mod, "REENTRANT_X", reentrant_x,default=.true.) - tripolar_n = .false. ; call get_param(PF, mod, "TRIPOLAR_N", tripolar_n, default=.false.) - call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, default=0.0) + reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) + tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, default=0.0) - call get_param(PF, mod, "NKML",nkml,default=0) - call get_param(PF, mod, "NKBL",nkbl,default=0) + call get_param(PF, mdl, "NKML",nkml,default=0) + call get_param(PF, mdl, "NKBL",nkbl,default=0) - call get_param(PF, mod, "TEMP_SALT_Z_INIT_FILE",filename, & + call get_param(PF, mdl, "TEMP_SALT_Z_INIT_FILE",filename, & "The name of the z-space input file used to initialize \n"//& "temperatures (T) and salinities (S). If T and S are not \n" //& "in the same file, TEMP_Z_INIT_FILE and SALT_Z_INIT_FILE \n" //& "must be set.",default="temp_salt_z.nc") - call get_param(PF, mod, "TEMP_Z_INIT_FILE",tfilename, & + call get_param(PF, mdl, "TEMP_Z_INIT_FILE",tfilename, & "The name of the z-space input file used to initialize \n"//& "temperatures, only.", default=trim(filename)) - call get_param(PF, mod, "SALT_Z_INIT_FILE",sfilename, & + call get_param(PF, mdl, "SALT_Z_INIT_FILE",sfilename, & "The name of the z-space input file used to initialize \n"//& "temperatures, only.", default=trim(filename)) filename = trim(inputdir)//trim(filename) tfilename = trim(inputdir)//trim(tfilename) sfilename = trim(inputdir)//trim(sfilename) - call get_param(PF, mod, "Z_INIT_FILE_PTEMP_VAR", potemp_var, & + call get_param(PF, mdl, "Z_INIT_FILE_PTEMP_VAR", potemp_var, & "The name of the potential temperature variable in \n"//& "TEMP_Z_INIT_FILE.", default="ptemp") - call get_param(PF, mod, "Z_INIT_FILE_SALT_VAR", salin_var, & + call get_param(PF, mdl, "Z_INIT_FILE_SALT_VAR", salin_var, & "The name of the salinity variable in \n"//& "SALT_Z_INIT_FILE.", default="salt") - call get_param(PF, mod, "Z_INIT_HOMOGENIZE", homogenize, & + call get_param(PF, mdl, "Z_INIT_HOMOGENIZE", homogenize, & "If True, then horizontally homogenize the interpolated \n"//& - "initial conditions.", default=.false.) - call get_param(PF, mod, "Z_INIT_ALE_REMAPPING", useALEremapping, & + "initial conditions.", default=.false., do_not_log=just_read) + call get_param(PF, mdl, "Z_INIT_ALE_REMAPPING", useALEremapping, & "If True, then remap straight to model coordinate from file.",& - default=.false.) - call get_param(PF, mod, "Z_INIT_REMAPPING_SCHEME", remappingScheme, & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "Z_INIT_REMAPPING_SCHEME", remappingScheme, & "The remapping scheme to use if using Z_INIT_ALE_REMAPPING\n"//& - "is True.", default="PPM_IH4") - call get_param(PF, mod, "Z_INIT_REMAP_GENERAL", remap_general, & + "is True.", default="PPM_IH4", do_not_log=just_read) + call get_param(PF, mdl, "Z_INIT_REMAP_GENERAL", remap_general, & "If false, only initializes to z* coordinates.\n"//& "If true, allows initialization directly to general coordinates.",& - default=.false.) - call get_param(PF, mod, "Z_INIT_REMAP_FULL_COLUMN", remap_full_column, & + default=.false., do_not_log=just_read) + call get_param(PF, mdl, "Z_INIT_REMAP_FULL_COLUMN", remap_full_column, & "If false, only reconstructs profiles for valid data points.\n"//& "If true, inserts vanished layers below the valid data.",& - default=remap_general) - call get_param(PF, mod, "Z_INIT_REMAP_OLD_ALG", remap_old_alg, & + default=remap_general, do_not_log=just_read) + call get_param(PF, mdl, "Z_INIT_REMAP_OLD_ALG", remap_old_alg, & "If false, uses the preferred remapping algorithm for initialization.\n"//& "If true, use an older, less robust algorithm for remapping.",& - default=.true.) + default=.true., do_not_log=just_read) + call get_param(PF, mdl, "ICE_SHELF", use_ice_shelf, default=.false.) + if (use_ice_shelf) then + call get_param(PF, mdl, "ICE_THICKNESS_FILE", ice_shelf_file, & + "The file from which the ice bathymetry and area are read.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + shelf_file = trim(inputdir)//trim(ice_shelf_file) + if (.not.just_read) call log_param(PF, mdl, "INPUTDIR/THICKNESS_FILE", shelf_file) + call get_param(PF, mdl, "ICE_AREA_VARNAME", area_varname, & + "The name of the area variable in ICE_THICKNESS_FILE.", & + fail_if_missing=.not.just_read, do_not_log=just_read) + endif + if (.not.useALEremapping) then + call get_param(PF, mdl, "ADJUST_THICKNESS", correct_thickness, & + "If true, all mass below the bottom removed if the \n"//& + "topography is shallower than the thickness input file \n"//& + "would indicate.", default=.false., do_not_log=just_read) + + call get_param(PF, mdl, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & + "If true, all the interior layers are adjusted to \n"//& + "their target densities using mostly temperature \n"//& + "This approach can be problematic, particularly in the \n"//& + "high latitudes.", default=.true., do_not_log=just_read) + endif + if (just_read) then + call cpu_clock_end(id_clock_routine) + return ! All run-time parameters have been read, so return. + endif ! Read input grid coordinates for temperature and salinity field ! in z-coordinate dataset. The file is REQUIRED to contain the @@ -1804,7 +1978,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) ! to the North/South Pole past the limits of the input data, they are extrapolated using the average ! value at the northernmost/southernmost latitude. - call horiz_interp_and_extrap_tracer(tfilename, potemp_var,1.0,1, & G, temp_z, mask_z, z_in, z_edges_in, missing_value_temp, reentrant_x, tripolar_n, homogenize) @@ -1834,20 +2007,11 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) call pass_var(rho_z,G%Domain) ! This is needed for building an ALE grid under ice shelves - call get_param(PF, mod, "ICE_SHELF", use_ice_shelf, default=.false.) if (use_ice_shelf) then - call get_param(PF, mod, "ICE_THICKNESS_FILE", ice_shelf_file, & - "The file from which the ice bathymetry and area are read.", & - fail_if_missing=.true.) - filename = trim(inputdir)//trim(ice_shelf_file) - call log_param(PF, mod, "INPUTDIR/THICKNESS_FILE", filename) - call get_param(PF, mod, "ICE_AREA_VARNAME", area_varname, & - "The name of the area variable in ICE_THICKNESS_FILE.", & - fail_if_missing=.true.) - if (.not.file_exists(filename, G%Domain)) call MOM_error(FATAL, & - "MOM_temp_salt_initialize_from_Z: Unable to open "//trim(filename)) - - call read_data(filename,trim(area_varname),area_shelf_h,domain=G%Domain%mpp_domain) + if (.not.file_exists(shelf_file, G%Domain)) call MOM_error(FATAL, & + "MOM_temp_salt_initialize_from_Z: Unable to open shelf file "//trim(shelf_file)) + + call read_data(shelf_file,trim(area_varname),area_shelf_h,domain=G%Domain%mpp_domain) ! initialize frac_shelf_h with zeros (open water everywhere) frac_shelf_h(:,:) = 0.0 @@ -1906,7 +2070,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) ! Build the target grid (and set the model thickness to it) ! This call can be more general but is hard-coded for z* coordinates... ???? - call ALE_initRegridding( GV, G%max_depth, PF, mod, regridCS ) ! sets regridCS + call ALE_initRegridding( GV, G%max_depth, PF, mdl, regridCS ) ! sets regridCS if (.not. remap_general) then ! This is the old way of initializing to z* coordinates only @@ -1972,17 +2136,6 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) zi(is:ie,js:je,:) = find_interfaces(rho_z(is:ie,js:je,:), z_in, Rb, G%bathyT(is:ie,js:je), & nlevs(is:ie,js:je), nkml, nkbl, min_depth) - call get_param(PF, mod, "ADJUST_THICKNESS", correct_thickness, & - "If true, all mass below the bottom removed if the \n"//& - "topography is shallower than the thickness input file \n"//& - "would indicate.", default=.false.) - - call get_param(PF, mod, "FIT_TO_TARGET_DENSITY_IC", adjust_temperature, & - "If true, all the interior layers are adjusted to \n"//& - "their target densities using mostly temperature \n"//& - "This approach can be problematic, particularly in the \n"//& - "high latitudes.", default=.true.) - if (correct_thickness) then call adjustEtaToFitBathymetry(G, GV, zi, h) else @@ -2016,31 +2169,25 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) nlevs(is:ie,js:je)) do k=1,nz - - nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. - do j=js,je - do i=is,ie - if (G%mask2dT(i,j) .ge. 1.0) then - nPoints = nPoints + 1 - tempAvg = tempAvg + tv%T(i,j,k) - saltAvg =saltAvg + tv%S(i,j,k) - endif - enddo - enddo - - ! Horizontally homogenize data to produce perfectly "flat" initial conditions - if (homogenize) then - call sum_across_PEs(nPoints) - call sum_across_PEs(tempAvg) - call sum_across_PEs(saltAvg) - if (nPoints>0) then - tempAvg = tempAvg/real(nPoints) - saltAvg = saltAvg/real(nPoints) - endif - tv%T(:,:,k) = tempAvg - tv%S(:,:,k) = saltAvg - endif - + nPoints = 0 ; tempAvg = 0. ; saltAvg = 0. + do j=js,je ; do i=is,ie ; if (G%mask2dT(i,j) >= 1.0) then + nPoints = nPoints + 1 + tempAvg = tempAvg + tv%T(i,j,k) + saltAvg =saltAvg + tv%S(i,j,k) + endif ; enddo ; enddo + + ! Horizontally homogenize data to produce perfectly "flat" initial conditions + if (homogenize) then + call sum_across_PEs(nPoints) + call sum_across_PEs(tempAvg) + call sum_across_PEs(saltAvg) + if (nPoints>0) then + tempAvg = tempAvg/real(nPoints) + saltAvg = saltAvg/real(nPoints) + endif + tv%T(:,:,k) = tempAvg + tv%S(:,:,k) = saltAvg + endif enddo endif ! useALEremapping @@ -2068,7 +2215,7 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, G, GV, PF, dirs) call pass_var(tv%T, G%Domain) call pass_var(tv%S, G%Domain) - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') call cpu_clock_end(id_clock_routine) end subroutine MOM_temp_salt_initialize_from_Z diff --git a/src/initialization/MOM_tracer_initialization_from_Z.F90 b/src/initialization/MOM_tracer_initialization_from_Z.F90 index f6e12b665a..246d47dc5c 100644 --- a/src/initialization/MOM_tracer_initialization_from_Z.F90 +++ b/src/initialization/MOM_tracer_initialization_from_Z.F90 @@ -43,7 +43,7 @@ module MOM_tracer_initialization_from_Z public :: MOM_initialize_tracer_from_Z, horiz_interp_and_extrap_tracer -character(len=40) :: mod = "MOM_tracer_initialization_from_Z" ! This module's name. +character(len=40) :: mdl = "MOM_tracer_initialization_from_Z" ! This module's name. interface fill_boundaries module procedure fill_boundaries_real @@ -89,7 +89,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_initialize_tracers_from_Z" ! This module's name. + character(len=40) :: mdl = "MOM_initialize_tracers_from_Z" ! This module's name. integer :: is, ie, js, je, nz ! compute domain indices integer :: isc,iec,jsc,jec ! global compute domain indices @@ -124,24 +124,24 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg - call callTree_enter(trim(mod)//"(), MOM_state_initialization.F90") + call callTree_enter(trim(mdl)//"(), MOM_state_initialization.F90") call mpp_get_compute_domain(G%domain%mpp_domain,isc,iec,jsc,jec) - call get_param(PF, mod, "Z_INIT_HOMOGENIZE", homog, & + call get_param(PF, mdl, "Z_INIT_HOMOGENIZE", homog, & "If True, then horizontally homogenize the interpolated \n"//& "initial conditions.", default=.false.) - call get_param(PF, mod, "Z_INIT_ALE_REMAPPING", useALE, & + call get_param(PF, mdl, "Z_INIT_ALE_REMAPPING", useALE, & "If True, then remap straight to model coordinate from file.",& default=.true.) - call get_param(PF, mod, "Z_INIT_REMAPPING_SCHEME", remapScheme, & + call get_param(PF, mdl, "Z_INIT_REMAPPING_SCHEME", remapScheme, & "The remapping scheme to use if using Z_INIT_ALE_REMAPPING\n"//& "is True.", default="PLM") ! These are model grid properties, but being applied to the data grid for now. ! need to revisit this (mjh) - reentrant_x = .false. ; call get_param(PF, mod, "REENTRANT_X", reentrant_x,default=.true.) - tripolar_n = .false. ; call get_param(PF, mod, "TRIPOLAR_N", tripolar_n, default=.false.) + reentrant_x = .false. ; call get_param(PF, mdl, "REENTRANT_X", reentrant_x,default=.true.) + tripolar_n = .false. ; call get_param(PF, mdl, "TRIPOLAR_N", tripolar_n, default=.false.) if (PRESENT(homogenize)) homog=homogenize @@ -224,7 +224,7 @@ subroutine MOM_initialize_tracer_from_Z(h, tr, G, GV, PF, src_file, src_var_nam, enddo ; enddo ; enddo - call callTree_leave(trim(mod)//'()') + call callTree_leave(trim(mdl)//'()') call cpu_clock_end(id_clock_routine) diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index 354f25f5dd..48acbd4ef1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -798,14 +798,14 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) logical :: laplacian, useVarMix, coldStart ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_MEKE" ! This module's name. + character(len=40) :: mdl = "MOM_MEKE" ! This module's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed ! Determine whether this module will be used - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "USE_MEKE", MEKE_init, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "USE_MEKE", MEKE_init, & "If true, turns on the MEKE scheme which calculates\n"// & "a sub-grid mesoscale eddy kinetic energy budget.", & default=.false.) @@ -826,137 +826,137 @@ logical function MEKE_init(Time, G, param_file, diag, CS, MEKE, restart_CS) call MOM_mesg("MEKE_init: reading parameters ", 5) ! Read all relevant parameters and write them to the model log. - call get_param(param_file, mod, "MEKE_DAMPING", CS%MEKE_damping, & + call get_param(param_file, mdl, "MEKE_DAMPING", CS%MEKE_damping, & "The local depth-indepented MEKE dissipation rate.", & units="s-1", default=0.0) - call get_param(param_file, mod, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & + call get_param(param_file, mdl, "MEKE_CD_SCALE", CS%MEKE_Cd_scale, & "The ratio of the bottom eddy velocity to the column mean\n"//& "eddy velocity, i.e. sqrt(2*MEKE). This should be less than 1\n"//& "to account for the surface intensification of MEKE.", & units="nondim", default=0.) - call get_param(param_file, mod, "MEKE_CB", CS%MEKE_Cb, & + call get_param(param_file, mdl, "MEKE_CB", CS%MEKE_Cb, & "A coefficient in the expression for the ratio of bottom projected\n"//& "eddy energy and mean column energy (see Jansen et al. 2015).",& units="nondim", default=25.) - call get_param(param_file, mod, "MEKE_MIN_GAMMA2", CS%MEKE_min_gamma, & + call get_param(param_file, mdl, "MEKE_MIN_GAMMA2", CS%MEKE_min_gamma, & "The minimum allowed value of gamma_b^2.",& units="nondim", default=0.0001) - call get_param(param_file, mod, "MEKE_CT", CS%MEKE_Ct, & + call get_param(param_file, mdl, "MEKE_CT", CS%MEKE_Ct, & "A coefficient in the expression for the ratio of barotropic\n"//& "eddy energy and mean column energy (see Jansen et al. 2015).",& units="nondim", default=50.) - call get_param(param_file, mod, "MEKE_GMCOEFF", CS%MEKE_GMcoeff, & + call get_param(param_file, mdl, "MEKE_GMCOEFF", CS%MEKE_GMcoeff, & "The efficiency of the conversion of potential energy \n"//& "into MEKE by the thickness mixing parameterization. \n"//& "If MEKE_GMCOEFF is negative, this conversion is not \n"//& "used or calculated.", units="nondim", default=-1.0) - call get_param(param_file, mod, "MEKE_FRCOEFF", CS%MEKE_FrCoeff, & + call get_param(param_file, mdl, "MEKE_FRCOEFF", CS%MEKE_FrCoeff, & "The efficiency of the conversion of mean energy into \n"//& "MEKE. If MEKE_FRCOEFF is negative, this conversion \n"//& "is not used or calculated.", units="nondim", default=-1.0) - call get_param(param_file, mod, "MEKE_BGSRC", CS%MEKE_BGsrc, & + call get_param(param_file, mdl, "MEKE_BGSRC", CS%MEKE_BGsrc, & "A background energy source for MEKE.", units="W kg-1", & default=0.0) - call get_param(param_file, mod, "MEKE_KH", CS%MEKE_Kh, & + call get_param(param_file, mdl, "MEKE_KH", CS%MEKE_Kh, & "A background lateral diffusivity of MEKE.\n"//& "Use a negative value to not apply lateral diffusion to MEKE.", & units="m2 s-1", default=-1.0) - call get_param(param_file, mod, "MEKE_K4", CS%MEKE_K4, & + call get_param(param_file, mdl, "MEKE_K4", CS%MEKE_K4, & "A lateral bi-harmonic diffusivity of MEKE.\n"//& "Use a negative value to not apply bi-harmonic diffusion to MEKE.", & units="m4 s-1", default=-1.0) - call get_param(param_file, mod, "MEKE_DTSCALE", CS%MEKE_dtScale, & + call get_param(param_file, mdl, "MEKE_DTSCALE", CS%MEKE_dtScale, & "A scaling factor to accelerate the time evolution of MEKE.", & units="nondim", default=1.0) - call get_param(param_file, mod, "MEKE_KHCOEFF", CS%MEKE_KhCoeff, & + call get_param(param_file, mdl, "MEKE_KHCOEFF", CS%MEKE_KhCoeff, & "A scaling factor in the expression for eddy diffusivity\n"//& "which is otherwise proportional to the MEKE velocity-\n"//& "scale times an eddy mixing-length. This factor\n"//& "must be >0 for MEKE to contribute to the thickness/\n"//& "and tracer diffusivity in the rest of the model.", & units="nondim", default=1.0) - call get_param(param_file, mod, "MEKE_USCALE", CS%MEKE_Uscale, & + call get_param(param_file, mdl, "MEKE_USCALE", CS%MEKE_Uscale, & "The background velocity that is combined with MEKE to \n"//& "calculate the bottom drag.", units="m s-1", default=0.0) - call get_param(param_file, mod, "MEKE_VISC_DRAG", CS%visc_drag, & + call get_param(param_file, mdl, "MEKE_VISC_DRAG", CS%visc_drag, & "If true, use the vertvisc_type to calculate the bottom \n"//& "drag acting on MEKE.", default=.true.) - call get_param(param_file, mod, "MEKE_KHTH_FAC", MEKE%KhTh_fac, & + call get_param(param_file, mdl, "MEKE_KHTH_FAC", MEKE%KhTh_fac, & "A factor that maps MEKE%Kh to KhTh.", units="nondim", & default=0.0) - call get_param(param_file, mod, "MEKE_KHTR_FAC", MEKE%KhTr_fac, & + call get_param(param_file, mdl, "MEKE_KHTR_FAC", MEKE%KhTr_fac, & "A factor that maps MEKE%Kh to KhTr.", units="nondim", & default=0.0) - call get_param(param_file, mod, "MEKE_KHMEKE_FAC", CS%KhMEKE_Fac, & + call get_param(param_file, mdl, "MEKE_KHMEKE_FAC", CS%KhMEKE_Fac, & "A factor that maps MEKE%Kh to Kh for MEKE itself.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_OLD_LSCALE", CS%use_old_lscale, & + call get_param(param_file, mdl, "MEKE_OLD_LSCALE", CS%use_old_lscale, & "If true, use the old formula for length scale which is\n"//& "a function of grid spacing and deformation radius.", & default=.false.) - call get_param(param_file, mod, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & + call get_param(param_file, mdl, "MEKE_RD_MAX_SCALE", CS%Rd_as_max_scale, & "If true, the length scale used by MEKE is the minimum of\n"//& "the deformation radius or grid-spacing. Only used if\n"//& "MEKE_OLD_LSCALE=True", units="nondim", default=.false.) - call get_param(param_file, mod, "MEKE_VISCOSITY_COEFF", CS%viscosity_coeff, & + call get_param(param_file, mdl, "MEKE_VISCOSITY_COEFF", CS%viscosity_coeff, & "If non-zero, is the scaling coefficient in the expression for\n"//& "viscosity used to parameterize lateral momentum mixing by\n"//& "unresolved eddies represented by MEKE. Can be negative to\n"//& "represent backscatter from the unresolved eddies.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & + call get_param(param_file, mdl, "MEKE_FIXED_MIXING_LENGTH", CS%Lfixed, & "If positive, is a fixed length contribution to the expression\n"//& "for mixing length used in MEKE-derived diffusiviity.", & units="m", default=0.0) - call get_param(param_file, mod, "MEKE_ALPHA_DEFORM", CS%aDeform, & + call get_param(param_file, mdl, "MEKE_ALPHA_DEFORM", CS%aDeform, & "If positive, is a coefficient weighting the deformation scale\n"//& "in the expression for mixing length used in MEKE-derived diffusiviity.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_ALPHA_RHINES", CS%aRhines, & + call get_param(param_file, mdl, "MEKE_ALPHA_RHINES", CS%aRhines, & "If positive, is a coefficient weighting the Rhines scale\n"//& "in the expression for mixing length used in MEKE-derived diffusiviity.", & units="nondim", default=0.05) - call get_param(param_file, mod, "MEKE_ALPHA_EADY", CS%aEady, & + call get_param(param_file, mdl, "MEKE_ALPHA_EADY", CS%aEady, & "If positive, is a coefficient weighting the Eady length scale\n"//& "in the expression for mixing length used in MEKE-derived diffusiviity.", & units="nondim", default=0.05) - call get_param(param_file, mod, "MEKE_ALPHA_FRICT", CS%aFrict, & + call get_param(param_file, mdl, "MEKE_ALPHA_FRICT", CS%aFrict, & "If positive, is a coefficient weighting the frictional arrest scale\n"//& "in the expression for mixing length used in MEKE-derived diffusiviity.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_ALPHA_GRID", CS%aGrid, & + call get_param(param_file, mdl, "MEKE_ALPHA_GRID", CS%aGrid, & "If positive, is a coefficient weighting the grid-spacing as a scale\n"//& "in the expression for mixing length used in MEKE-derived diffusiviity.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_COLD_START", coldStart, & + call get_param(param_file, mdl, "MEKE_COLD_START", coldStart, & "If true, initialize EKE to zero. Otherwise a local equilibrium solution\n"//& "is used as an initial condition for EKE.", default=.false.) - call get_param(param_file, mod, "MEKE_BACKSCAT_RO_C", MEKE%backscatter_Ro_c, & + call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_C", MEKE%backscatter_Ro_c, & "The coefficient in the Rossby number function for scaling the buharmonic\n"//& "frictional energy source. Setting to non-zero enables the Rossby number function.", & units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_BACKSCAT_RO_POW", MEKE%backscatter_Ro_pow, & + call get_param(param_file, mdl, "MEKE_BACKSCAT_RO_POW", MEKE%backscatter_Ro_pow, & "The power in the Rossby number function for scaling the biharmomnic\n"//& "frictional energy source.", units="nondim", default=0.0) - call get_param(param_file, mod, "MEKE_ADVECTION_FACTOR", CS%MEKE_advection_factor, & + call get_param(param_file, mdl, "MEKE_ADVECTION_FACTOR", CS%MEKE_advection_factor, & "A scale factor in front of advection of eddy energy. Zero turns advection off.\n"//& "Using unity would be normal but other values could accomodate a mismatch\n"//& "between the advecting barotropic flow and the vertical structure of MEKE.", & units="nondim", default=0.0) ! Nonlocal module parameters - call get_param(param_file, mod, "CDRAG", CS%cdrag, & + call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& "the velocity field to the bottom stress.", units="nondim", & default=0.003) - call get_param(param_file, mod, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "LAPLACIAN", laplacian, default=.false., do_not_log=.true.) if (CS%viscosity_coeff/=0. .and. .not. laplacian) call MOM_error(FATAL, & "LAPLACIAN must be true if MEKE_VISCOSITY_COEFF is true.") - call get_param(param_file, mod, "USE_VARIABLE_MIXING", useVarMix, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "USE_VARIABLE_MIXING", useVarMix, default=.false., do_not_log=.true.) if (.not. useVarMix .and. CS%aEady>0.) call MOM_error(FATAL, & "USE_VARIABLE_MIXING must be true if USE_MEKE is true and MEKE_ALPHA_EADY>0.") - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) ! Allocation of storage NOT shared with other modules if (CS%MEKE_K4>=0.) then diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 708e26babb..3df2f00615 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -133,6 +133,8 @@ module MOM_hor_visc ! nonlinear eddy viscosity. AH is the background. logical :: Leith_Kh ! If true, use 2D Leith nonlinear eddy ! viscosity. KH is the background value. + logical :: Modified_Leith ! If true, use extra component of Leith viscosity + ! to damp divergent flow. To use, still set Leith_Kh=.TRUE. logical :: Leith_Ah ! If true, use a biharmonic form of 2D Leith ! nonlinear eddy viscosity. AH is the background. logical :: bound_Coriolis ! If true & SMAGORINSKY_AH is used, the biharmonic @@ -216,18 +218,39 @@ module MOM_hor_visc contains +!> This subroutine determines the acceleration due to the +!! horizontal viscosity. A combination of biharmonic and Laplacian +!! forms can be used. The coefficient may either be a constant or +!! a shear-dependent form. The biharmonic is determined by twice +!! taking the divergence of an appropriately defined stress tensor. +!! The Laplacian is determined by doing so once. +!! To work, the following fields must be set outside of the usual +!! is to ie range before this subroutine is called: +!! v[is-2,is-1,ie+1,ie+2], u[is-2,is-1,ie+1,ie+2], and h[is-1,ie+1], +!! with a similarly sized halo in the y-direction. subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, OBC) - 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(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: diffu - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: diffv - type(MEKE_type), pointer :: MEKE - type(VarMix_CS), pointer :: VarMix - type(hor_visc_CS), pointer :: CS - type(ocean_OBC_type), pointer, optional :: OBC + 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(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: diffu !< Zonal acceleration due to convergence of + !! along-coordinate stress tensor (m/s2) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: diffv !< Meridional acceleration due to convergence + !! of along-coordinate stress tensor (m/s2). + type(MEKE_type), pointer :: MEKE !< Pointer to a structure containing fields + !! related to Mesoscale Eddy Kinetic Energy. + type(VarMix_CS), pointer :: VarMix !< Pointer to a structure with fields that + !! specify the spatially variable viscosities + type(hor_visc_CS), pointer :: CS !< Pontrol structure returned by a previous + !! call to hor_visc_init. + type(ocean_OBC_type), pointer, optional :: OBC !< Pointer to an open boundary condition type ! Arguments: ! (in) u - zonal velocity (m/s) @@ -270,6 +293,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, sh_xx, & ! horizontal tension (du/dx - dv/dy) (1/sec) including metric terms str_xx,& ! str_xx is the diagonal term in the stress tensor (H m2 s-2) bhstr_xx,& ! A copy of str_xx that only contains the biharmonic contribution (H m2 s-2) + div_xx, & ! horizontal divergence (du/dx + dv/dy) (1/sec) including metric terms FrictWorkIntz ! depth integrated energy dissipated by lateral friction (W/m2) real, dimension(SZIB_(G),SZJB_(G)) :: & @@ -280,10 +304,12 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vort_xy ! vertical vorticity (dv/dx - du/dy) (1/sec) including metric terms real, dimension(SZI_(G),SZJB_(G)) :: & - vort_xy_dx ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 sec-1) including metric terms + vort_xy_dx, & ! x-derivative of vertical vorticity (d/dx(dv/dx - du/dy)) (m-1 sec-1) including metric terms + div_xx_dy ! y-derivative of horizontal divergence (d/dy(du/dx + dv/dy)) (m-1 sec-1) including metric terms real, dimension(SZIB_(G),SZJ_(G)) :: & - vort_xy_dy ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 sec-1) including metric terms + vort_xy_dy, & ! y-derivative of vertical vorticity (d/dy(dv/dx - du/dy)) (m-1 sec-1) including metric terms + div_xx_dx ! x-derivative of horizontal divergence (d/dx(du/dx + dv/dy)) (m-1 sec-1) including metric terms real, dimension(SZIB_(G),SZJB_(G),SZK_(G)) :: & Ah_q, & ! biharmonic viscosity at corner points (m4/s) @@ -300,6 +326,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, real :: KhSm ! Smagorinsky Laplacian viscosity (m2/s) real :: AhLth ! 2D Leith biharmonic viscosity (m4/s) real :: KhLth ! 2D Leith Laplacian viscosity (m2/s) + real :: mod_Leith ! nondimensional coefficient for divergence part of modified Leith + ! viscosity. Here set equal to nondimensional Laplacian Leith constant. + ! This is set equal to zero if modified Leith is not used. real :: Shear_mag ! magnitude of the shear (1/s) real :: Vort_mag ! magnitude of the vorticity (1/s) real :: h2uq, h2vq ! temporary variables in units of H^2 (i.e. m2 or kg2 m-4). @@ -367,6 +396,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, !$OMP sh_xy, str_xy, Ah, Kh, AhSm, KhSm, dvdx, dudy, & !$OMP bhstr_xx, bhstr_xy,FatH,RoScl, hu, hv, h_u, h_v, & !$OMP vort_xy,vort_xy_dx,vort_xy_dy,Vort_mag,AhLth,KhLth, & +!$OMP div_xx, div_xx_dx, div_xx_dy, mod_Leith, & !$OMP Shear_mag, h2uq, h2vq, hq, Kh_scale, hrat_min) do k=1,nz @@ -388,6 +418,11 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, G%IdyCu(I-1,j) * u(I-1,j,k)) - & CS%DX_dyT(i,j)*(G%IdxCv(i,J) * v(i,J,k) - & G%IdxCv(i,J-1)*v(i,J-1,k))) + div_xx(i,j) = 0.5*((G%dyCu(I,j) * u(I,j,k) * (h(i+1,j,k)+h(i,j,k)) - & + G%dyCu(I-1,j) * u(I-1,j,k) * (h(i-1,j,k)+h(i,j,k)) ) + & + (G%dxCv(i,J) * v(i,J,k) * (h(i,j,k)+h(i,j+1,k)) - & + G%dxCv(i,J-1)*v(i,J-1,k)*(h(i,j,k)+h(i,j-1,k))))*G%IareaT(i,j)/ & + (h(i,j,k) + h_neglect) enddo ; enddo ! Components for the shearing strain do J=js-2,Jeq+1 ; do I=is-2,Ieq+1 @@ -519,6 +554,22 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, vort_xy_dy(I,j) = CS%DX_dyBu(I,J)*(vort_xy(I,J)*G%IdxCv(i,J) - vort_xy(I,J-1)*G%IdxCv(i,J-1)) enddo ; enddo +! Divergence gradient + do j=Jsq-1,Jeq+2 ; do I=is-2,Ieq+1 + div_xx_dx(I,j) = G%IdxCu(I,j)*(div_xx(i+1,j) - div_xx(i,j)) + enddo ; enddo + + do J=js-2,Jeq+1 ; do i=Isq-1,Ieq+2 + div_xx_dy(i,J) = G%IdyCv(i,J)*(div_xx(i,j+1) - div_xx(i,j)) + enddo ; enddo + +! Coefficient for modified Leith + if (CS%Modified_Leith) then + mod_Leith = 1.0 + else + mod_Leith = 0.0 + endif + ! Evaluate u0 = x.Div(Grad u) and v0 = y.Div( Grad u) if (CS%biharmonic) then do j=js-1,Jeq+1 ; do I=Isq-1,Ieq+1 @@ -551,10 +602,13 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, 0.25*((sh_xy(I-1,J-1)*sh_xy(I-1,J-1) + sh_xy(I,J)*sh_xy(I,J)) + & (sh_xy(I-1,J)*sh_xy(I-1,J) + sh_xy(I,J-1)*sh_xy(I,J-1)))) endif - if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) & + if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) then Vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J-1)*vort_xy_dx(i,J-1) + vort_xy_dx(i,J)*vort_xy_dx(i,J)) + & - (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j)))) + (vort_xy_dy(I-1,j)*vort_xy_dy(I-1,j) + vort_xy_dy(I,j)*vort_xy_dy(I,j))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I-1,j)*div_xx_dx(I-1,j)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i,J-1)*div_xx_dy(i,J-1)))) + endif if (CS%better_bound_Ah .or. CS%better_bound_Kh) then hrat_min = min(1.0, min(h_u(I,j), h_u(I-1,j), h_v(i,J), h_v(i,J-1)) / & (h(i,j,k) + h_neglect) ) @@ -681,7 +735,9 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, if ((CS%Leith_Kh) .or. (CS%Leith_Ah)) & Vort_mag = sqrt( & 0.5*((vort_xy_dx(i,J)*vort_xy_dx(i,J) + vort_xy_dx(i+1,J)*vort_xy_dx(i+1,J)) + & - (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1)))) + (vort_xy_dy(I,j)*vort_xy_dy(I,j) + vort_xy_dy(I,j+1)*vort_xy_dy(I,j+1))) + & + mod_Leith*0.5*((div_xx_dx(I,j)*div_xx_dx(I,j) + div_xx_dx(I,j+1)*div_xx_dx(I,j+1)) + & + (div_xx_dy(i,J)*div_xx_dy(i,J) + div_xx_dy(i+1,J)*div_xx_dy(i+1,J)))) h2uq = 4.0 * h_u(I,j) * h_u(I,j+1) h2vq = 4.0 * h_v(i,J) * h_v(i+1,J) @@ -929,13 +985,18 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, CS, end subroutine horizontal_viscosity - +!> This subroutine allocates space for and calculates static variables +!! used by this module. The metrics may be 0, 1, or 2-D arrays, +!! while fields like the background viscosities are 2-D arrays. +!! ALLOC is a macro defined in MOM_memory.h to either allocate +!! for dynamic memory, or do nothing when using static memory. subroutine hor_visc_init(Time, G, param_file, diag, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(hor_visc_CS), pointer :: CS + type(time_type), intent(in) :: Time !< current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid 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. + type(hor_visc_CS), pointer :: CS !< pointer to the control structure for this module ! This subroutine allocates space for and calculates static variables ! used by this module. The metrics may be 0, 1, or 2-D arrays, @@ -991,7 +1052,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_hor_visc" ! module name + character(len=40) :: mdl = "MOM_hor_visc" ! module name is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB @@ -1008,101 +1069,108 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") ! It is not clear whether these initialization lines are needed for the ! cases where the corresponding parameters are not read. CS%bound_Kh = .false. ; CS%better_bound_Kh = .false. ; CS%Smagorinsky_Kh = .false. ; CS%Leith_Kh = .false. CS%bound_Ah = .false. ; CS%better_bound_Ah = .false. ; CS%Smagorinsky_Ah = .false. ; CS%Leith_Ah = .false. CS%bound_Coriolis = .false. + CS%Modified_Leith = .false. Kh = 0.0 ; Ah = 0.0 ! If GET_ALL_PARAMS is true, all parameters are read in all cases to enable ! parameter spelling checks. - call get_param(param_file, mod, "GET_ALL_PARAMS", get_all, default=.false.) + call get_param(param_file, mdl, "GET_ALL_PARAMS", get_all, default=.false.) - call get_param(param_file, mod, "LAPLACIAN", CS%Laplacian, & + call get_param(param_file, mdl, "LAPLACIAN", CS%Laplacian, & "If true, use a Laplacian horizontal viscosity.", & default=.false.) if (CS%Laplacian .or. get_all) then - call get_param(param_file, mod, "KH", Kh, & + call get_param(param_file, mdl, "KH", Kh, & "The background Laplacian horizontal viscosity.", & units = "m2 s-1", default=0.0) - call get_param(param_file, mod, "KH_BG_MIN", CS%Kh_bg_min, & + call get_param(param_file, mdl, "KH_BG_MIN", CS%Kh_bg_min, & "The minimum value allowed for Laplacian horizontal viscosity, KH.", & units = "m2 s-1", default=0.0) - call get_param(param_file, mod, "KH_VEL_SCALE", Kh_vel_scale, & + call get_param(param_file, mdl, "KH_VEL_SCALE", Kh_vel_scale, & "The velocity scale which is multiplied by the grid \n"//& "spacing to calculate the Laplacian viscosity. \n"//& "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and KH.", & units="m s-1", default=0.0) - call get_param(param_file, mod, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & + call get_param(param_file, mdl, "SMAGORINSKY_KH", CS%Smagorinsky_Kh, & "If true, use a Smagorinsky nonlinear eddy viscosity.", & default=.false.) if (CS%Smagorinsky_Kh .or. get_all) & - call get_param(param_file, mod, "SMAG_LAP_CONST", Smag_Lap_const, & + call get_param(param_file, mdl, "SMAG_LAP_CONST", Smag_Lap_const, & "The nondimensional Laplacian Smagorinsky constant, \n"//& "often 0.15.", units="nondim", default=0.0, & fail_if_missing = CS%Smagorinsky_Kh) - call get_param(param_file, mod, "LEITH_KH", CS%Leith_Kh, & + call get_param(param_file, mdl, "LEITH_KH", CS%Leith_Kh, & "If true, use a Leith nonlinear eddy viscosity.", & default=.false.) + + call get_param(param_file, mdl, "MODIFIED_LEITH", CS%Modified_Leith, & + "If true, add a term to Leith viscosity which is \n"//& + "proportional to the gradient of divergence.", & + default=.false.) + if (CS%Leith_Kh .or. get_all) & - call get_param(param_file, mod, "LEITH_LAP_CONST", Leith_Lap_const, & + call get_param(param_file, mdl, "LEITH_LAP_CONST", Leith_Lap_const, & "The nondimensional Laplacian Leith constant, \n"//& "often ??", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Kh) - call get_param(param_file, mod, "BOUND_KH", CS%bound_Kh, & + call get_param(param_file, mdl, "BOUND_KH", CS%bound_Kh, & "If true, the Laplacian coefficient is locally limited \n"//& "to be stable.", default=.true.) - call get_param(param_file, mod, "BETTER_BOUND_KH", CS%better_bound_Kh, & + call get_param(param_file, mdl, "BETTER_BOUND_KH", CS%better_bound_Kh, & "If true, the Laplacian coefficient is locally limited \n"//& "to be stable with a better bounding than just BOUND_KH.", & default=CS%bound_Kh) endif - call get_param(param_file, mod, "BIHARMONIC", CS%biharmonic, & + call get_param(param_file, mdl, "BIHARMONIC", CS%biharmonic, & "If true, use a biharmonic horizontal viscosity. \n"//& "BIHARMONIC may be used with LAPLACIAN.", & default=.true.) if (CS%biharmonic .or. get_all) then - call get_param(param_file, mod, "AH", Ah, & + call get_param(param_file, mdl, "AH", Ah, & "The background biharmonic horizontal viscosity.", & units = "m4 s-1", default=0.0) - call get_param(param_file, mod, "AH_VEL_SCALE", Ah_vel_scale, & + call get_param(param_file, mdl, "AH_VEL_SCALE", Ah_vel_scale, & "The velocity scale which is multiplied by the cube of \n"//& "the grid spacing to calculate the biharmonic viscosity. \n"//& "The final viscosity is the largest of this scaled \n"//& "viscosity, the Smagorinsky and Leith viscosities, and AH.", & units="m s-1", default=0.0) - call get_param(param_file, mod, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & + call get_param(param_file, mdl, "SMAGORINSKY_AH", CS%Smagorinsky_Ah, & "If true, use a biharmonic Smagorinsky nonlinear eddy \n"//& "viscosity.", default=.false.) - call get_param(param_file, mod, "LEITH_AH", CS%Leith_Ah, & + call get_param(param_file, mdl, "LEITH_AH", CS%Leith_Ah, & "If true, use a biharmonic Leith nonlinear eddy \n"//& "viscosity.", default=.false.) - call get_param(param_file, mod, "BOUND_AH", CS%bound_Ah, & + call get_param(param_file, mdl, "BOUND_AH", CS%bound_Ah, & "If true, the biharmonic coefficient is locally limited \n"//& "to be stable.", default=.true.) - call get_param(param_file, mod, "BETTER_BOUND_AH", CS%better_bound_Ah, & + call get_param(param_file, mdl, "BETTER_BOUND_AH", CS%better_bound_Ah, & "If true, the biharmonic coefficient is locally limited \n"//& "to be stable with a better bounding than just BOUND_AH.", & default=CS%bound_Ah) if (CS%Smagorinsky_Ah .or. get_all) then - call get_param(param_file, mod, "SMAG_BI_CONST",Smag_bi_const, & + call get_param(param_file, mdl, "SMAG_BI_CONST",Smag_bi_const, & "The nondimensional biharmonic Smagorinsky constant, \n"//& "typically 0.015 - 0.06.", units="nondim", default=0.0, & fail_if_missing = CS%Smagorinsky_Ah) - call get_param(param_file, mod, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) - call get_param(param_file, mod, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & + call get_param(param_file, mdl, "BOUND_CORIOLIS", bound_Cor_def, default=.false.) + call get_param(param_file, mdl, "BOUND_CORIOLIS_BIHARM", CS%bound_Coriolis, & "If true use a viscosity that increases with the square \n"//& "of the velocity shears, so that the resulting viscous \n"//& "drag is of comparable magnitude to the Coriolis terms \n"//& @@ -1110,9 +1178,9 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "points is 0.5*BOUND_CORIOLIS_VEL. The default is the \n"//& "value of BOUND_CORIOLIS (or false).", default=bound_Cor_def) if (CS%bound_Coriolis .or. get_all) then - call get_param(param_file, mod, "MAXVEL", maxvel, default=3.0e8) + call get_param(param_file, mdl, "MAXVEL", maxvel, default=3.0e8) bound_Cor_vel = maxvel - call get_param(param_file, mod, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & + call get_param(param_file, mdl, "BOUND_CORIOLIS_VEL", bound_Cor_vel, & "The velocity scale at which BOUND_CORIOLIS_BIHARM causes \n"//& "the biharmonic drag to have comparable magnitude to the \n"//& "Coriolis acceleration. The default is set by MAXVEL.", & @@ -1121,7 +1189,7 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif if (CS%Leith_Ah .or. get_all) then - call get_param(param_file, mod, "LEITH_BI_CONST",Leith_bi_const, & + call get_param(param_file, mdl, "LEITH_BI_CONST",Leith_bi_const, & "The nondimensional biharmonic Leith constant, \n"//& "typical values are thus far undetermined", units="nondim", default=0.0, & fail_if_missing = CS%Leith_Ah) @@ -1130,13 +1198,13 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) endif if (CS%better_bound_Ah .or. CS%better_bound_Kh .or. get_all) & - call get_param(param_file, mod, "HORVISC_BOUND_COEF", CS%bound_coef, & + call get_param(param_file, mdl, "HORVISC_BOUND_COEF", CS%bound_coef, & "The nondimensional coefficient of the ratio of the \n"//& "viscosity bounds to the theoretical maximum for \n"//& "stability without considering other terms.", units="nondim", & default=0.8) - call get_param(param_file, mod, "NOSLIP", CS%no_slip, & + call get_param(param_file, mdl, "NOSLIP", CS%no_slip, & "If true, no slip boundary conditions are used; otherwise \n"//& "free slip boundary conditions are assumed. The \n"//& "implementation of the free slip BCs on a C-grid is much \n"//& @@ -1144,14 +1212,14 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) "is strongly encouraged, and no slip BCs are not used with \n"//& "the biharmonic viscosity.", default=.false.) - call get_param(param_file, mod, "USE_KH_BG_2D", CS%use_Kh_bg_2d, & + call get_param(param_file, mdl, "USE_KH_BG_2D", CS%use_Kh_bg_2d, & "If true, read a file containing 2-d background harmonic \n"//& "viscosities. The final viscosity is the maximum of the other "//& "terms and this background value.", default=.false.) if (CS%bound_Kh .or. CS%bound_Ah .or. CS%better_bound_Kh .or. CS%better_bound_Ah) & - call get_param(param_file, mod, "DT", dt, & + call get_param(param_file, mdl, "DT", dt, & "The (baroclinic) dynamics time step.", units = "s", & fail_if_missing=.true.) @@ -1194,10 +1262,10 @@ subroutine hor_visc_init(Time, G, param_file, diag, CS) if (CS%use_Kh_bg_2d) then ALLOC_(CS%Kh_bg_2d(isd:ied,jsd:jed)) ; CS%Kh_bg_2d(:,:) = 0.0 - call get_param(param_file, mod, "KH_BG_2D_FILENAME", filename, & + call get_param(param_file, mdl, "KH_BG_2D_FILENAME", filename, & 'The filename containing a 2d map of "Kh".', & default='KH_background_2d.nc') - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) call read_data(trim(inputdir)//trim(filename), 'Kh', CS%Kh_bg_2d, & domain=G%domain%mpp_domain, timelevel=1) diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 243e97a12e..1fb793f56f 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -197,19 +197,29 @@ module MOM_internal_tides contains - +!> This subroutine calls other subroutines in this file that are needed to +!! refract, propagate, and dissipate energy density of the internal tide. subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & G, GV, CS) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & - intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(thermo_var_ptrs), intent(in) :: tv - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide, Nb - real, intent(in) :: dt - type(int_tide_CS), pointer :: CS - real, dimension(SZI_(G),SZJ_(G),CS%nMode), intent(in) :: cn + intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(thermo_var_ptrs), intent(in) :: tv !< Pointer to thermodynamic variables + !! (needed for wave structure). + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: TKE_itidal_input !< The energy input to the + !! internal waves, in W m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: vel_btTide !< Barotropic velocity read + !! from file, in m s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: Nb !< Near-bottom buoyancy frequency, in s-1. + real, intent(in) :: dt !< Length of time over which these fluxes + !! will be applied, in s. + type(int_tide_CS), pointer :: CS !< A pointer to the control structure + !! returned by a previous call to + !! int_tide_init. + real, dimension(SZI_(G),SZJ_(G),CS%nMode), & + intent(in) :: cn ! This subroutine calls other subroutines in this file that are needed to ! refract, propagate, and dissipate energy density of the internal tide. @@ -645,8 +655,9 @@ subroutine propagate_int_tide(h, tv, cn, TKE_itidal_input, vel_btTide, Nb, dt, & end subroutine propagate_int_tide +!> This subroutine checks for energy conservation on computational domain subroutine sum_En(G, CS, En, label) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(int_tide_CS), pointer :: CS real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle), intent(in) :: En character(len=*), intent(in) :: label @@ -685,16 +696,27 @@ subroutine sum_En(G, CS, En, label) end subroutine sum_En +!> This subroutine calculates the energy lost from the propagating internal tide due to +!! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001). subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, full_halos) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), pointer :: CS - real, dimension(G%isd:G%ied,G%jsd:G%jed), intent(in) :: Nb - real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), intent(inout) :: Ub - real, dimension(G%isd:G%ied,G%jsd:G%jed), intent(in) :: TKE_loss_fixed - real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), intent(inout) :: En - real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), intent(out) :: TKE_loss - real, intent(in) :: dt - logical,optional, intent(in) :: full_halos + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(int_tide_CS), pointer :: CS + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(in) :: Nb !< Near-bottom stratification, in s-1. + real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%nFreq,CS%nMode), & + intent(inout) :: Ub !< Rms (over one period) near-bottom horizontal + !! mode velocity , in m s-1. + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(in) :: TKE_loss_fixed !< Fixed part of energy loss, + !! in kg m-2 (rho*kappa*h^2). + real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & + intent(inout) :: En !< Energy density of the internal waves, in J m-2. + real, dimension(G%isd:G%ied,G%jsd:G%jed,CS%NAngle,CS%nFreq,CS%nMode), & + intent(out) :: TKE_loss !< Energy loss rate, in W m-2 + !! (q*rho*kappa*h^2*N*U^2). + real, intent(in) :: dt !< Time increment, in s. + logical,optional, intent(in) :: full_halos !< If true, do the calculation over the + !! entirecomputational domain. ! This subroutine calculates the energy lost from the propagating internal tide due to ! scattering over small-scale roughness along the lines of Jayne & St. Laurent (2001). @@ -774,13 +796,17 @@ subroutine itidal_lowmode_loss(G, CS, Nb, Ub, En, TKE_loss_fixed, TKE_loss, dt, end subroutine itidal_lowmode_loss - +!> This subroutine extracts the energy lost from the propagating internal which has +!> been summed across all angles, frequencies, and modes for a given mechanism and location. +!> It can be called from another module to get values from this module's (private) CS. subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) - integer, intent(in) :: i,j - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(int_tide_CS), pointer :: CS - character(len=*), intent(in) :: mechanism - real, intent(out) :: TKE_loss_sum + integer, intent(in) :: i,j + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(int_tide_CS), pointer :: CS + character(len=*), intent(in) :: mechanism + real, intent(out) :: TKE_loss_sum !< Total energy loss rate due to specified + !! mechanism, in W m-2. + ! This subroutine extracts the energy lost from the propagating internal which has ! been summed across all angles, frequencies, and modes for a given mechanism and location. ! It can be called from another module to get values from this module's (private) CS. @@ -795,15 +821,20 @@ subroutine get_lowmode_loss(i,j,G,CS,mechanism,TKE_loss_sum) end subroutine get_lowmode_loss - +!> This subroutine does refraction on the internal waves at a single frequency. subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), intent(inout) :: En - real, dimension(G%isd:G%ied,G%jsd:G%jed), intent(in) :: cn - real, intent(in) :: freq - real, intent(in) :: dt - logical, intent(in) :: use_PPMang + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: En !< The internal gravity wave energy density as a + !! function of space and angular resolution, + !! in J m-2 radian-1. + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(in) :: cn !< Baroclinic mode speed, in m s-1. + real, intent(in) :: freq !< Wave frequency, in s-1. + real, intent(in) :: dt !< Time step, in s. + logical, intent(in) :: use_PPMang !< If true, use PPM for advection rather + !! than upwind. ! This subroutine does refraction on the internal waves at a single frequency. ! Arguments: @@ -936,13 +967,17 @@ subroutine refract(En, cn, freq, dt, G, NAngle, use_PPMang) enddo ! j-loop end subroutine refract - +!> This subroutine calculates the 1-d flux for advection in angular space +!! using a monotonic piecewise parabolic scheme. Should be within i and j spatial +!! loops. subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) integer, intent(in) :: NAngle real, intent(in) :: dt integer, intent(in) :: halo_ang - real, dimension(1-halo_ang:NAngle+halo_ang), intent(in) :: En2d - real, dimension(1-halo_ang:NAngle+halo_ang), intent(in) :: CFL_ang + real, dimension(1-halo_ang:NAngle+halo_ang), & + intent(in) :: En2d + real, dimension(1-halo_ang:NAngle+halo_ang), & + intent(in) :: CFL_ang real, dimension(0:NAngle), intent(out) :: Flux_En ! This subroutine calculates the 1-d flux for advection in angular space @@ -1015,14 +1050,18 @@ subroutine PPM_angular_advect(En2d, CFL_ang, Flux_En, NAngle, dt, halo_ang) enddo end subroutine PPM_angular_advect - +!> This subroutine does refraction on the internal waves at a single frequency. subroutine propagate(En, cn, freq, dt, G, CS, NAngle) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), intent(inout) :: En - real, dimension(G%isd:G%ied,G%jsd:G%jed), intent(in) :: cn - real, intent(in) :: freq - real, intent(in) :: dt + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: En !< The internal gravity wave energy density as a + !! function of space and angular resolution, + !! in J m-2 radian-1. + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(in) :: cn !< Baroclinic mode speed, in m s-1. + real, intent(in) :: freq !< Wave frequency, in s-1. + real, intent(in) :: dt !< Time step, in s. type(int_tide_CS), pointer :: CS ! This subroutine does refraction on the internal waves at a single frequency. @@ -1141,16 +1180,23 @@ subroutine propagate(En, cn, freq, dt, G, CS, NAngle) endif end subroutine propagate - +!> This subroutine does first-order corner advection. It was written with the hopes +!! of smoothing out the garden sprinkler effect, but is too numerically diffusive to +!! be of much use as of yet. It is not yet compatible with reflection schemes (BDM). subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS, LB) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(G%isd:G%ied,G%jsd:G%jed), intent(inout) :: En - real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), intent(in) :: speed - integer, intent(in) :: energized_wedge + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(G%isd:G%ied,G%jsd:G%jed), & + intent(inout) :: En !< The energy density integrated over an angular + !! band, in W m-2, intent in/out. + real, dimension(G%IsdB:G%IedB,G%Jsd:G%Jed), & + intent(in) :: speed !< The magnitude of the group velocity at the cell + !! corner points, in m s-1. + integer, intent(in) :: energized_wedge !< Index of current ray direction. integer, intent(in) :: NAngle - real, intent(in) :: dt - type(int_tide_CS), pointer :: CS - type(loop_bounds_type), intent(in) :: LB + real, intent(in) :: dt !< Time increment in s. + type(int_tide_CS), pointer :: CS !< The control structure returned by a previous + !! call to continuity_PPM_init. + type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. ! This subroutine does first-order corner advection. It was written with the hopes ! of smoothing out the garden sprinkler effect, but is too numerically diffusive to @@ -1411,15 +1457,22 @@ subroutine propagate_corner_spread(En, energized_wedge, NAngle, speed, dt, G, CS enddo; enddo end subroutine propagate_corner_spread +! #@# This subroutine needs a doxygen description subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), intent(inout) :: En - real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), intent(in) :: speed_x - real, dimension(Nangle), intent(in) :: Cgx_av, dCgx - real, intent(in) :: dt - type(int_tide_CS), pointer :: CS - type(loop_bounds_type), intent(in) :: LB + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, intent(in) :: NAngle + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: En !< The energy density integrated over an angular + !! band, in J m-2, intent in/out. + real, dimension(G%IsdB:G%IedB,G%jsd:G%jed), & + intent(in) :: speed_x !< The magnitude of the group velocity at the + !! Cu points, in m s-1. + real, dimension(Nangle), intent(in) :: Cgx_av, dCgx + real, intent(in) :: dt !< Time increment in s. + type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call + !! to continuity_PPM_init. + type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + ! Arguments: En - The energy density integrated over an angular band, in J m-2, ! intent in/out. ! (in) speed_x - The magnitude of the group velocity at the Cu @@ -1493,15 +1546,22 @@ subroutine propagate_x(En, speed_x, Cgx_av, dCgx, dt, G, Nangle, CS, LB) end subroutine propagate_x +! #@# This subroutine needs a doxygen description. subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), intent(inout) :: En - real, dimension(G%isd:G%ied,G%JsdB:G%JedB), intent(in) :: speed_y - real, dimension(Nangle), intent(in) :: Cgy_av, dCgy - real, intent(in) :: dt - type(int_tide_CS), pointer :: CS - type(loop_bounds_type), intent(in) :: LB + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + integer, intent(in) :: NAngle + real, dimension(G%isd:G%ied,G%jsd:G%jed,Nangle), & + intent(inout) :: En !< The energy density integrated over an angular + !! band, in J m-2, intent in/out. + real, dimension(G%isd:G%ied,G%JsdB:G%JedB), & + intent(in) :: speed_y !< The magnitude of the group velocity at the + !! Cv points, in m s-1. + real, dimension(Nangle), intent(in) :: Cgy_av, dCgy + real, intent(in) :: dt !< Time increment in s. + type(int_tide_CS), pointer :: CS !< The control structure returned by a previous call + !! to continuity_PPM_init. + type(loop_bounds_type), intent(in) :: LB !< A structure with the active energy loop bounds. + ! Arguments: En - The energy density integrated over an angular band, in J m-2, ! intent in/out. ! (in) speed_y - The magnitude of the group velocity at the Cv @@ -1583,17 +1643,23 @@ subroutine propagate_y(En, speed_y, Cgy_av, dCgy, dt, G, Nangle, CS, LB) end subroutine propagate_y - +!> This subroutines evaluates the zonal mass or volume fluxes in a layer. subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity, in m s-1 - real, dimension(SZI_(G)), intent(in) :: h - real, dimension(SZI_(G)), intent(in) :: hL - real, dimension(SZI_(G)), intent(in) :: hR - real, dimension(SZIB_(G)), intent(inout) :: uh - real, intent(in) :: dt - integer, intent(in) :: j, ish, ieh - logical, intent(in) :: vol_CFL + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZIB_(G)), intent(in) :: u !< The zonal velocity, in m s-1. + real, dimension(SZI_(G)), intent(in) :: h !< Energy density used to calculate the fluxes, + !! in J m-2. + real, dimension(SZI_(G)), intent(in) :: hL !< Left- Energy densities in the reconstruction, + !! in J m-2. + real, dimension(SZI_(G)), intent(in) :: hR !< Right- Energy densities in the reconstruction, + !! in J m-2. + real, dimension(SZIB_(G)), intent(inout) :: uh !< The zonal energy transport, + !! in J s-1. + real, intent(in) :: dt !< Time increment in s. + integer, intent(in) :: j, ish, ieh !< The index range to work on. + logical, intent(in) :: vol_CFL !< If true, rescale the ratio of face areas to + !! the cell areas when estimating the CFL number. + ! This subroutines evaluates the zonal mass or volume fluxes in a layer. ! ! Arguments: u - Zonal velocity, in m s-1. @@ -1630,15 +1696,23 @@ subroutine zonal_flux_En(u, h, hL, hR, uh, dt, G, j, ish, ieh, vol_CFL) enddo end subroutine zonal_flux_En - +!> This subroutines evaluates the meridional mass or volume fluxes in a layer. subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity, in m s-1 - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h, hL, hR - real, dimension(SZI_(G)), intent(inout) :: vh - real, intent(in) :: dt - integer, intent(in) :: J, ish, ieh - logical, intent(in) :: vol_CFL + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G)), intent(in) :: v !< The meridional velocity, in m s-1. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h !< Energy density used to calculate the + !! fluxes, in J m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hL !< Left- Energy densities in the + !! reconstruction, in J m-2. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: hR !< Right- Energy densities in the + !! reconstruction, in J m-2. + real, dimension(SZI_(G)), intent(inout) :: vh !< The meridional energy transport, + !! in J s-1. + real, intent(in) :: dt !< Time increment in s. + integer, intent(in) :: J, ish, ieh !< The index range to work on. + logical, intent(in) :: vol_CFL !< If true, rescale the ratio of face + !! areas to the cell areas when estimating + !! the CFL number. ! This subroutines evaluates the meridional mass or volume fluxes in a layer. ! ! Arguments: v - Meridional velocity, in m s-1. @@ -1674,11 +1748,12 @@ subroutine merid_flux_En(v, h, hL, hR, vh, dt, G, J, ish, ieh, vol_CFL) enddo end subroutine merid_flux_En - +!> This subroutine does reflection of the internal waves at a single frequency. subroutine reflect(En, NAngle, CS, G, LB) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), intent(inout) :: En + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: En type(int_tide_CS), pointer :: CS type(loop_bounds_type), intent(in) :: LB @@ -1790,10 +1865,13 @@ subroutine reflect(En, NAngle, CS, G, LB) end subroutine reflect +!> This subroutine moves energy across lines of partial reflection to prevent +!! reflection of energy that is supposed to get across. subroutine teleport(En, NAngle, CS, G, LB) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. integer, intent(in) :: NAngle - real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), intent(inout) :: En + real, dimension(G%isd:G%ied,G%jsd:G%jed,NAngle), & + intent(inout) :: En type(int_tide_CS), pointer :: CS type(loop_bounds_type), intent(in) :: LB @@ -1888,6 +1966,8 @@ subroutine teleport(En, NAngle, CS, G, LB) end subroutine teleport +!> This subroutine rotates points in the halos where required to accomodate +!! changes in grid orientation, such as at the tripolar fold. subroutine correct_halo_rotation(En, test, G, NAngle) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(:,:,:,:,:), intent(inout) :: En @@ -1940,12 +2020,17 @@ subroutine correct_halo_rotation(En, test, G, NAngle) enddo end subroutine correct_halo_rotation +!> This subroutine calculates left/right edge values for PPM reconstruction. subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l, h_r - type(loop_bounds_type), intent(in) :: LB - logical, optional, intent(in) :: simple_2nd + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. + logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + !! energy densities as default edge values + !! for a simple 2nd order scheme. + ! This subroutine calculates left/right edge values for PPM reconstruction. ! Arguments: h_in - Energy density in a sector (2D) ! (out) h_l,h_r - left/right edge value of reconstruction (2D) @@ -2020,13 +2105,17 @@ subroutine PPM_reconstruction_x(h_in, h_l, h_r, G, LB, simple_2nd) call PPM_limit_pos(h_in, h_l, h_r, 0.0, G, isl, iel, jsl, jel) end subroutine PPM_reconstruction_x - +!> This subroutine calculates left/right edge valus for PPM reconstruction. subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l, h_r - type(loop_bounds_type), intent(in) :: LB - logical, optional, intent(in) :: simple_2nd + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Energy density in a sector (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_l !< Left edge value of reconstruction (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: h_r !< Right edge value of reconstruction (2D). + type(loop_bounds_type), intent(in) :: LB !< A structure with the active loop bounds. + logical, optional, intent(in) :: simple_2nd !< If true, use the arithmetic mean + !! energy densities as default edge values + !! for a simple 2nd order scheme. + ! This subroutine calculates left/right edge valus for PPM reconstruction. ! Arguments: h_in - Energy density in a sector (2D) ! (out) h_l,h_r - left/right edge value of reconstruction (2D) @@ -2099,13 +2188,20 @@ subroutine PPM_reconstruction_y(h_in, h_l, h_r, G, LB, simple_2nd) call PPM_limit_pos(h_in, h_l, h_r, 0.0, G, isl, iel, jsl, jel) end subroutine PPM_reconstruction_y - +!> This subroutine limits the left/right edge values of the PPM reconstruction +!! to give a reconstruction that is positive-definite. Here this is +!! reinterpreted as giving a constant thickness if the mean thickness is less +!! than h_min, with a minimum of h_min otherwise. subroutine PPM_limit_pos(h_in, h_L, h_R, h_min, G, iis, iie, jis, jie) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in - real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L, h_R - real, intent(in) :: h_min - integer, intent(in) :: iis, iie, jis, jie + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: h_in !< Thickness of layer (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_L !< Left edge value (2D). + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: h_R !< Right edge value (2D). + real, intent(in) :: h_min !< The minimum thickness that can be + !! obtained by a concave parabolic fit. + integer, intent(in) :: iis, iie, jis, jie !< Index range for + !! computation. + ! This subroutine limits the left/right edge values of the PPM reconstruction ! to give a reconstruction that is positive-definite. Here this is ! reinterpreted as giving a constant thickness if the mean thickness is less @@ -2199,13 +2295,18 @@ end subroutine PPM_limit_pos ! end subroutine register_int_tide_restarts +! #@# This subroutine needs a doxygen comment. subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) - type(time_type), target, intent(in) :: Time - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(int_tide_CS),pointer :: CS + type(time_type), target, intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(int_tide_CS),pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. + ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -2229,7 +2330,7 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) type(axes_grp) :: axes_ang ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_internal_tides" ! This module's name. + character(len=40) :: mdl = "MOM_internal_tides" ! This module's name. character(len=16), dimension(8) :: freq_name character(len=40) :: var_name character(len=160) :: var_descript @@ -2287,18 +2388,18 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) CS%Time => Time ! direct a pointer to the current model time target - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "INTERNAL_TIDE_FREQS", num_freq, & + call get_param(param_file, mdl, "INTERNAL_TIDE_FREQS", num_freq, & "The number of distinct internal tide frequency bands \n"//& "that will be calculated.", default=1) - call get_param(param_file, mod, "INTERNAL_TIDE_MODES", num_mode, & + call get_param(param_file, mdl, "INTERNAL_TIDE_MODES", num_mode, & "The number of distinct internal tide modes \n"//& "that will be calculated.", default=1) - call get_param(param_file, mod, "INTERNAL_TIDE_ANGLES", num_angle, & + call get_param(param_file, mdl, "INTERNAL_TIDE_ANGLES", num_angle, & "The number of angular resolution bands for the internal \n"//& "tide calculations.", default=24) @@ -2328,17 +2429,17 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) CS%diag => diag - call get_param(param_file, mod, "INTERNAL_TIDE_DECAY_RATE", CS%decay_rate, & + call get_param(param_file, mdl, "INTERNAL_TIDE_DECAY_RATE", CS%decay_rate, & "The rate at which internal tide energy is lost to the \n"//& "interior ocean internal wave field.", units="s-1", default=0.0) - call get_param(param_file, mod, "INTERNAL_TIDE_VOLUME_BASED_CFL", CS%vol_CFL, & + call get_param(param_file, mdl, "INTERNAL_TIDE_VOLUME_BASED_CFL", CS%vol_CFL, & "If true, use the ratio of the open face lengths to the \n"//& "tracer cell areas when estimating CFL numbers in the \n"//& "internal tide code.", default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_CORNER_ADVECT", CS%corner_adv, & + call get_param(param_file, mdl, "INTERNAL_TIDE_CORNER_ADVECT", CS%corner_adv, & "If true, internal tide ray-tracing advection uses a \n"//& " corner-advection scheme rather than PPM.\n", default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_SIMPLE_2ND_PPM", CS%simple_2nd, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SIMPLE_2ND_PPM", CS%simple_2nd, & "If true, CONTINUITY_PPM uses a simple 2nd order \n"//& "(arithmetic mean) interpolation of the edge values. \n"//& "This may give better PV conservation propterties. While \n"//& @@ -2346,44 +2447,44 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) "solver itself in the strongly advective limit, it does \n"//& "not reduce the overall order of accuracy of the dynamic \n"//& "core.", default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_UPWIND_1ST", CS%upwind_1st, & + call get_param(param_file, mdl, "INTERNAL_TIDE_UPWIND_1ST", CS%upwind_1st, & "If true, the internal tide ray-tracing advection uses \n"//& "1st-order upwind advection. This scheme is highly \n"//& "continuity solver. This scheme is highly \n"//& "diffusive but may be useful for debugging.", default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_BACKGROUND_DRAG", & + call get_param(param_file, mdl, "INTERNAL_TIDE_BACKGROUND_DRAG", & CS%apply_background_drag, "If true, the internal tide \n"//& "ray-tracing advection uses a background drag term as a sink.",& default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_QUAD_DRAG", CS%apply_bottom_drag, & + call get_param(param_file, mdl, "INTERNAL_TIDE_QUAD_DRAG", CS%apply_bottom_drag, & "If true, the internal tide ray-tracing advection uses \n"//& "a quadratic bottom drag term as a sink.", default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & + call get_param(param_file, mdl, "INTERNAL_TIDE_WAVE_DRAG", CS%apply_wave_drag, & "If true, apply scattering due to small-scale roughness as a sink.", & default=.false.) - call get_param(param_file, mod, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & + call get_param(param_file, mdl, "INTERNAL_TIDE_FROUDE_DRAG", CS%apply_Froude_drag, & "If true, apply wave breaking as a sink.", & default=.false.) - call get_param(param_file, mod, "CDRAG", CS%cdrag, & + call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& "the velocity field to the bottom stress.", units="nondim", & default=0.003) - call get_param(param_file, mod, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & + call get_param(param_file, mdl, "INTERNAL_TIDE_ENERGIZED_ANGLE", CS%energized_angle, & "If positive, only one angular band of the internal tides \n"//& "gets all of the energy. (This is for debugging.)", default=-1) - call get_param(param_file, mod, "USE_PPM_ANGULAR", CS%use_PPMang, & + call get_param(param_file, mdl, "USE_PPM_ANGULAR", CS%use_PPMang, & "If true, use PPM for advection of energy in angular \n"//& "space.", default=.false.) - call get_param(param_file, mod, "GAMMA_ITIDES", CS%q_itides, & + call get_param(param_file, mdl, "GAMMA_ITIDES", CS%q_itides, & "The fraction of the internal tidal energy that is \n"//& "dissipated locally with INT_TIDE_DISSIPATION. \n"//& "THIS NAME COULD BE BETTER.", & units="nondim", default=0.3333) - call get_param(param_file, mod, "KAPPA_ITIDES", kappa_itides, & + call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) - call get_param(param_file, mod, "KAPPA_H2_FACTOR", kappa_h2_factor, & + call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) @@ -2405,12 +2506,12 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) allocate(CS%tot_Froude_loss(isd:ied,jsd:jed)) ; CS%tot_Froude_loss(:,:) = 0.0 ! Compute the fixed part of the bottom drag loss from baroclinic modes - call get_param(param_file, mod, "H2_FILE", h2_file, & + call get_param(param_file, mdl, "H2_FILE", h2_file, & "The path to the file containing the sub-grid-scale \n"//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) - call log_param(param_file, mod, "INPUTDIR/H2_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call read_data(filename, 'h2', h2, domain=G%domain%mpp_domain, timelevel=1) do j=G%jsc,G%jec ; do i=G%isc,G%iec ! Restrict rms topo to 10 percent of column depth. @@ -2422,12 +2523,12 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) enddo; enddo ! Read in prescribed coast/ridge/shelf angles from file - call get_param(param_file, mod, "REFL_ANGLE_FILE", refl_angle_file, & + call get_param(param_file, mdl, "REFL_ANGLE_FILE", refl_angle_file, & "The path to the file containing the local angle of \n"//& "the coastline/ridge/shelf with respect to the equator.", & fail_if_missing=.false.) filename = trim(CS%inputdir) // trim(refl_angle_file) - call log_param(param_file, mod, "INPUTDIR/REFL_ANGLE_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/REFL_ANGLE_FILE", filename) allocate(CS%refl_angle(isd:ied,jsd:jed)) ; CS%refl_angle(:,:) = CS%nullangle call read_data(filename, 'refl_angle', CS%refl_angle, & domain=G%domain%mpp_domain, timelevel=1) @@ -2438,11 +2539,11 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) call pass_var(CS%refl_angle,G%domain) ! Read in prescribed partial reflection coefficients from file - call get_param(param_file, mod, "REFL_PREF_FILE", refl_pref_file, & + call get_param(param_file, mdl, "REFL_PREF_FILE", refl_pref_file, & "The path to the file containing the reflection coefficients.", & fail_if_missing=.false.) filename = trim(CS%inputdir) // trim(refl_pref_file) - call log_param(param_file, mod, "INPUTDIR/REFL_PREF_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/REFL_PREF_FILE", filename) allocate(CS%refl_pref(isd:ied,jsd:jed)) ; CS%refl_pref(:,:) = 1.0 call read_data(filename, 'refl_pref', CS%refl_pref, & domain=G%domain%mpp_domain, timelevel=1) @@ -2462,11 +2563,11 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) enddo ! Read in double-reflective (ridge) tags from file - call get_param(param_file, mod, "REFL_DBL_FILE", refl_dbl_file, & + call get_param(param_file, mdl, "REFL_DBL_FILE", refl_dbl_file, & "The path to the file containing the double-reflective ridge tags.", & fail_if_missing=.false.) filename = trim(CS%inputdir) // trim(refl_dbl_file) - call log_param(param_file, mod, "INPUTDIR/REFL_DBL_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/REFL_DBL_FILE", filename) allocate(ridge_temp(isd:ied,jsd:jed)) ; ridge_temp(:,:) = 0.0 call read_data(filename, 'refl_dbl', ridge_temp, & domain=G%domain%mpp_domain, timelevel=1) @@ -2480,11 +2581,11 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) ! Read in prescribed land mask from file (if overwriting -BDM). ! This should be done in MOM_initialize_topography subroutine ! defined in MOM_fixed_initialization.F90 (BDM) - !call get_param(param_file, mod, "LAND_MASK_FILE", land_mask_file, & + !call get_param(param_file, mdl, "LAND_MASK_FILE", land_mask_file, & ! "The path to the file containing the land mask.", & ! fail_if_missing=.false.) !filename = trim(CS%inputdir) // trim(land_mask_file) - !call log_param(param_file, mod, "INPUTDIR/LAND_MASK_FILE", filename) + !call log_param(param_file, mdl, "INPUTDIR/LAND_MASK_FILE", filename) !G%mask2dCu(:,:) = 1 ; G%mask2dCv(:,:) = 1 ; G%mask2dT(:,:) = 1 !call read_data(filename, 'land_mask', G%mask2dCu, & ! domain=G%domain%mpp_domain, timelevel=1) @@ -2497,31 +2598,31 @@ subroutine internal_tides_init(Time, G, GV, param_file, diag, CS) !call pass_var(G%mask2dT,G%domain) ! Read in prescribed partial east face blockages from file (if overwriting -BDM) - !call get_param(param_file, mod, "dy_Cu_FILE", dy_Cu_file, & + !call get_param(param_file, mdl, "dy_Cu_FILE", dy_Cu_file, & ! "The path to the file containing the east face blockages.", & ! fail_if_missing=.false.) !filename = trim(CS%inputdir) // trim(dy_Cu_file) - !call log_param(param_file, mod, "INPUTDIR/dy_Cu_FILE", filename) + !call log_param(param_file, mdl, "INPUTDIR/dy_Cu_FILE", filename) !G%dy_Cu(:,:) = 0.0 !call read_data(filename, 'dy_Cu', G%dy_Cu, & ! domain=G%domain%mpp_domain, timelevel=1) !call pass_var(G%dy_Cu,G%domain) ! Read in prescribed partial north face blockages from file (if overwriting -BDM) - !call get_param(param_file, mod, "dx_Cv_FILE", dx_Cv_file, & + !call get_param(param_file, mdl, "dx_Cv_FILE", dx_Cv_file, & ! "The path to the file containing the north face blockages.", & ! fail_if_missing=.false.) !filename = trim(CS%inputdir) // trim(dx_Cv_file) - !call log_param(param_file, mod, "INPUTDIR/dx_Cv_FILE", filename) + !call log_param(param_file, mdl, "INPUTDIR/dx_Cv_FILE", filename) !G%dx_Cv(:,:) = 0.0 !call read_data(filename, 'dx_Cv', G%dx_Cv, & ! domain=G%domain%mpp_domain, timelevel=1) !call pass_var(G%dx_Cv,G%domain) ! For debugging - delete later - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_X", CS%int_tide_source_x, & "X Location of generation site for internal tide", default=1.) - call get_param(param_file, mod, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & + call get_param(param_file, mdl, "INTERNAL_TIDE_SOURCE_Y", CS%int_tide_source_y, & "Y Location of generation site for internal tide", default=1.) ! Register maps of reflection parameters diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index 4810d15229..4d75e470ba 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -45,6 +45,15 @@ module MOM_lateral_mixing_coeffs !! for layer thicknesses. In addition, masking at coastlines was not !! used which introduced potential restart issues. This flag will be !! deprecated in a future release. + logical :: calculate_cg1 !< If true, calls wave_speed() to calculate the first + !! baroclinic wave speed and populate CS%cg1. + !! This parameter is set depending on other parameters. + logical :: calculate_Rd_dx !< If true, calculates Rd/dx and populate CS%Rd_dx_h. + !! This parameter is set depending on other parameters. + logical :: calculate_res_fns !< If true, calculate all the resolution factors. + !! This parameter is set depending on other parameters. + logical :: calculate_Eady_growth_rate !< If true, calculate all the Eady growth rate. + !! This parameter is set depending on other parameters. real, dimension(:,:), pointer :: & SN_u => NULL(), & !< S*N at u-points (s^-1) SN_v => NULL(), & !< S*N at v-points (s^-1) @@ -139,10 +148,48 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_resoln_function:"// & "Module must be initialized before it is used.") - if (.not. (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. & - CS%Resoln_scaled_KhTr)) return - if (.not. ASSOCIATED(CS%cg1)) call MOM_error(FATAL, & - "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") + if (CS%calculate_cg1) then + if (.not. ASSOCIATED(CS%cg1)) call MOM_error(FATAL, & + "calc_resoln_function: %cg1 is not associated with Resoln_scaled_Kh.") + if (CS%khth_use_ebt_struct) then + if (.not. ASSOCIATED(CS%ebt_struct)) call MOM_error(FATAL, & + "calc_resoln_function: %ebt_struct is not associated with RESOLN_USE_EBT.") + if (CS%Resoln_use_ebt) then + ! Both resolution fn and vertical structure are using EBT + call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) + else + ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode + call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) + call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) + endif + call pass_var(CS%ebt_struct, G%Domain) + else + call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) + endif + + call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) + call do_group_pass(CS%pass_cg1, G%Domain) + endif + + ! Calculate and store the ratio between deformation radius and grid-spacing + ! at h-points (non-dimensional). + if (CS%calculate_rd_dx) then + if (.not. ASSOCIATED(CS%Rd_dx_h)) call MOM_error(FATAL, & + "calc_resoln_function: %Rd_dx_h is not associated with calculate_rd_dx.") +!$OMP parallel default(none) shared(is,ie,js,je,CS) +!$OMP do + do j=js-1,je+1 ; do i=is-1,ie+1 + CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & + (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) + enddo ; enddo +!$OMP end parallel + if (query_averaging_enabled(CS%diag)) then + if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) + endif + endif + + if (.not. CS%calculate_res_fns) return + if (.not. ASSOCIATED(CS%Res_fn_h)) call MOM_error(FATAL, & "calc_resoln_function: %Res_fn_h is not associated with Resoln_scaled_Kh.") if (.not. ASSOCIATED(CS%Res_fn_q)) call MOM_error(FATAL, & @@ -168,23 +215,6 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) if (.not. ASSOCIATED(CS%beta_dx2_v)) call MOM_error(FATAL, & "calc_resoln_function: %beta_dx2_v is not associated with Resoln_scaled_Kh.") - if (CS%khth_use_ebt_struct) then - if (CS%Resoln_use_ebt) then - ! Both resolution fn and vertical structure are using EBT - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct) - else - ! Use EBT to get vertical structure first and then re-calculate cg1 using first baroclinic mode - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp, modal_structure=CS%ebt_struct, use_ebt_mode=.true.) - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) - endif - call pass_var(CS%ebt_struct, G%Domain) - else - call wave_speed(h, tv, G, GV, CS%cg1, CS%wave_speed_CSp) - endif - - call create_group_pass(CS%pass_cg1, CS%cg1, G%Domain) - call do_group_pass(CS%pass_cg1, G%Domain) - ! Do this calculation on the extent used in MOM_hor_visc.F90, and ! MOM_tracer.F90 so that no halo update is needed. @@ -336,19 +366,10 @@ subroutine calc_resoln_function(h, tv, G, GV, CS) enddo ; enddo endif endif - - ! Calculate and store the ratio between deformation radius and grid-spacing - ! at h-points (non-dimensional). -!$OMP do - do j=js-1,je+1 ; do i=is-1,ie+1 - CS%Rd_dx_h(i,j) = CS%cg1(i,j) / & - (sqrt(CS%f2_dx2_h(i,j) + CS%cg1(i,j)*CS%beta_dx2_h(i,j))) - enddo ; enddo !$OMP end parallel if (query_averaging_enabled(CS%diag)) then if (CS%id_Res_fn > 0) call post_data(CS%id_Res_fn, CS%Res_fn_h, CS%diag) - if (CS%id_Rd_dx > 0) call post_data(CS%id_Rd_dx, CS%Rd_dx_h, CS%diag) endif end subroutine calc_resoln_function @@ -371,8 +392,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "MOM_lateral_mixing_coeffs.F90, calc_slope_functions:"//& "Module must be initialized before it is used.") - call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) - if (CS%use_variable_mixing) then + if (CS%calculate_Eady_growth_rate) then + call find_eta(h, tv, GV%g_Earth, G, GV, e, halo_size=2) if (CS%use_stored_slopes) then call calc_isoneutral_slopes(G, GV, h, e, tv, dt*CS%kappa_smooth, & CS%slope_x, CS%slope_y, N2_u, N2_v, 1) @@ -389,10 +410,8 @@ subroutine calc_slope_functions(h, tv, dt, G, GV, CS) if (CS%id_SN_v > 0) call post_data(CS%id_SN_v, CS%SN_v, CS%diag) if (CS%id_L2u > 0) call post_data(CS%id_L2u, CS%L2u, CS%diag) if (CS%id_L2v > 0) call post_data(CS%id_L2v, CS%L2v, CS%diag) - if (CS%use_stored_slopes) then - if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, N2_u, CS%diag) - if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, N2_v, CS%diag) - endif + if (CS%id_N2_u > 0) call post_data(CS%id_N2_u, N2_u, CS%diag) + if (CS%id_N2_v > 0) call post_data(CS%id_N2_v, N2_v, CS%diag) endif end subroutine calc_slope_functions @@ -407,7 +426,7 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real, dimension(SZIB_(G),SZJ_(G),SZK_(G)+1), intent(in) :: N2_u !< Brunt-Vaisala frequency at u-points (1/s2) real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: slope_y !< Meridional isoneutral slope real, dimension(SZI_(G),SZJB_(G),SZK_(G)+1), intent(in) :: N2_v !< Brunt-Vaisala frequency at v-points (1/s2) - type(VarMix_CS), intent(inout) :: CS !< Variable mixing coefficients + type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: E_x(SZIB_(G), SZJ_(G)) ! X-slope of interface at u points (for diagnostics) real :: E_y(SZI_(G), SZJB_(G)) ! Y-slope of interface at u points (for diagnostics) @@ -425,9 +444,9 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) real :: S2_u(SZIB_(G), SZJ_(G)) real :: S2_v(SZI_(G), SZJB_(G)) - if (LOC(CS)==0) call MOM_error(FATAL, "calc_slope_function:"// & + if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") - if (.not. CS%use_variable_mixing) return + if (.not. CS%calculate_Eady_growth_rate) return if (.not. ASSOCIATED(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") if (.not. ASSOCIATED(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & @@ -452,17 +471,6 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. - ! Set the length scale at u-points. -!$OMP do - do j=js,je ; do I=is-1,ie - CS%L2u(I,j) = CS%Visbeck_L_scale**2 - enddo ; enddo - ! Set length scale at v-points -!$OMP do - do J=js-1,je ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 - enddo ; enddo - !$OMP do do j = js,je do I=is-1,ie @@ -564,9 +572,9 @@ subroutine calc_Visbeck_coeffs(h, e, slope_x, slope_y, N2_u, N2_v, G, GV, CS) endif if (CS%debug) then - call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) - call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) - call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) + call uvchksum("calc_Visbeck_coeffs slope_[xy]", slope_x, slope_y, G%HI, haloshift=1) + call uvchksum("calc_Visbeck_coeffs N2_u, N2_v", N2_u, N2_v, G%HI) + call uvchksum("calc_Visbeck_coeffs SN_[uv]", CS%SN_u, CS%SN_v, G%HI) endif end subroutine calc_Visbeck_coeffs @@ -600,7 +608,7 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) if (.not. ASSOCIATED(CS)) call MOM_error(FATAL, "calc_slope_function:"// & "Module must be initialized before it is used.") - if (.not. CS%use_variable_mixing) return + if (.not. CS%calculate_Eady_growth_rate) return if (.not. ASSOCIATED(CS%SN_u)) call MOM_error(FATAL, "calc_slope_function:"// & "%SN_u is not associated with use_variable_mixing.") if (.not. ASSOCIATED(CS%SN_v)) call MOM_error(FATAL, "calc_slope_function:"// & @@ -625,16 +633,6 @@ subroutine calc_slope_functions_using_just_e(h, G, GV, CS, e, calculate_slopes) ! calculate the first-mode gravity wave speed and then blend the equatorial ! and midlatitude deformation radii, using calc_resoln_function as a template. - ! Set the length scale at u-points. -!$OMP do - do j=js,je ; do I=is-1,ie - CS%L2u(I,j) = CS%Visbeck_L_scale**2 - enddo ; enddo - ! Set length scale at v-points -!$OMP do - do J=js-1,je ; do i=is,ie - CS%L2v(i,J) = CS%Visbeck_L_scale**2 - enddo ; enddo !$OMP do do k=nz,CS%VarMix_Ktop,-1 @@ -730,15 +728,15 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) type(VarMix_CS), pointer :: CS !< Variable mixing coefficients ! Local variables real :: KhTr_Slope_Cff, KhTh_Slope_Cff, oneOrTwo, N2_filter_depth + real :: KhTr_passivity_coeff real, parameter :: absurdly_small_freq2 = 1e-34 ! A miniscule frequency ! squared that is used to avoid division by 0, in s-2. This ! value is roughly (pi / (the age of the universe) )^2. - logical :: use_variable_mixing, Gill_equatorial_Ld, use_stored_slopes - logical :: Resoln_scaled_Kh, Resoln_scaled_KhTh, Resoln_scaled_KhTr - logical :: Resoln_use_ebt, khth_use_ebt_struct + logical :: Gill_equatorial_Ld, use_FGNV_streamfn, use_MEKE, in_use + real :: MLE_front_length ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_lateral_mixing_coeffs" ! This module's name. + character(len=40) :: mdl = "MOM_lateral_mixing_coeffs" ! This module's name. integer :: is, ie, js, je, Isq, Ieq, Jsq, Jeq, i, j integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec @@ -752,185 +750,184 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) return endif + allocate(CS) + in_use = .false. ! Set to true to avoid deallocating + CS%diag => diag ! Diagnostics pointer + CS%calculate_cg1 = .false. + CS%calculate_Rd_dx = .false. + CS%calculate_res_fns = .false. + CS%calculate_Eady_growth_rate = .false. + ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - ! This first set of parameters are read into local variables first, in case - ! the control structure should not be allocated. - call get_param(param_file, mod, "USE_VARIABLE_MIXING", use_variable_mixing,& + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "USE_VARIABLE_MIXING", CS%use_variable_mixing,& "If true, the variable mixing code will be called. This \n"//& "allows diagnostics to be created even if the scheme is \n"//& "not used. If KHTR_SLOPE_CFF>0 or KhTh_Slope_Cff>0, \n"//& "this is set to true regardless of what is in the \n"//& "parameter file.", default=.false.) - call get_param(param_file, mod, "RESOLN_SCALED_KH", Resoln_scaled_Kh, & + call get_param(param_file, mdl, "RESOLN_SCALED_KH", CS%Resoln_scaled_Kh, & "If true, the Laplacian lateral viscosity is scaled away \n"//& "when the first baroclinic deformation radius is well \n"//& "resolved.", default=.false.) - call get_param(param_file, mod, "RESOLN_SCALED_KHTH", Resoln_scaled_KhTh, & + call get_param(param_file, mdl, "RESOLN_SCALED_KHTH", CS%Resoln_scaled_KhTh, & "If true, the interface depth diffusivity is scaled away \n"//& "when the first baroclinic deformation radius is well \n"//& "resolved.", default=.false.) - call get_param(param_file, mod, "RESOLN_SCALED_KHTR", Resoln_scaled_KhTr, & + call get_param(param_file, mdl, "RESOLN_SCALED_KHTR", CS%Resoln_scaled_KhTr, & "If true, the epipycnal tracer diffusivity is scaled \n"//& "away when the first baroclinic deformation radius is \n"//& "well resolved.", default=.false.) - call get_param(param_file, mod, "RESOLN_USE_EBT", Resoln_use_ebt, & + call get_param(param_file, mdl, "RESOLN_USE_EBT", CS%Resoln_use_ebt, & "If true, uses the equivalent barotropic wave speed instead\n"//& "of first baroclinic wave for calculating the resolution fn.",& default=.false.) - call get_param(param_file, mod, "KHTH_USE_EBT_STRUCT", khth_use_ebt_struct, & + call get_param(param_file, mdl, "KHTH_USE_EBT_STRUCT", CS%khth_use_ebt_struct, & "If true, uses the equivalent barotropic structure\n"//& "as the vertical structure of thickness diffusivity.",& default=.false.) - call get_param(param_file, mod, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & + call get_param(param_file, mdl, "KHTH_SLOPE_CFF", KhTh_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula \n"//& "for the interface depth diffusivity", units="nondim", & default=0.0) - call get_param(param_file, mod, "KHTR_SLOPE_CFF", KhTr_Slope_Cff, & + call get_param(param_file, mdl, "KHTR_SLOPE_CFF", KhTr_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula \n"//& "for the epipycnal tracer diffusivity", units="nondim", & default=0.0) - call get_param(param_file, mod, "USE_STORED_SLOPES", use_stored_slopes,& + call get_param(param_file, mdl, "USE_STORED_SLOPES", CS%use_stored_slopes,& "If true, the isopycnal slopes are calculated once and\n"//& "stored for re-use. This uses more memory but avoids calling\n"//& "the equation of state more times than should be necessary.", & default=.false.) - if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) use_variable_mixing = .true. - - if (use_variable_mixing .or. Resoln_scaled_Kh .or. Resoln_scaled_KhTh .or. & - Resoln_scaled_KhTr .or. use_stored_slopes .or. khth_use_ebt_struct) then - allocate(CS) - CS%diag => diag ! Diagnostics pointer - CS%Resoln_scaled_Kh = Resoln_scaled_Kh - CS%Resoln_scaled_KhTh = Resoln_scaled_KhTh - CS%Resoln_scaled_KhTr = Resoln_scaled_KhTr - CS%Resoln_use_ebt = Resoln_use_ebt - CS%khth_use_ebt_struct = khth_use_ebt_struct - CS%use_variable_mixing = use_variable_mixing - CS%use_stored_slopes = use_stored_slopes - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - else - return - endif - if (Resoln_use_ebt .or. khth_use_ebt_struct) then - call get_param(param_file, mod, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & + call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", use_FGNV_streamfn, & + default=.false., do_not_log=.true.) + CS%calculate_cg1 = CS%calculate_cg1 .or. use_FGNV_streamfn + call get_param(param_file, mdl, "USE_MEKE", use_MEKE, & + default=.false., do_not_log=.true.) + CS%calculate_Eady_growth_rate = CS%calculate_Eady_growth_rate .or. use_MEKE + call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", KhTr_passivity_coeff, & + default=0., do_not_log=.true.) + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (KhTr_passivity_coeff>0.) + call get_param(param_file, mdl, "MLE_FRONT_LENGTH", MLE_front_length, & + default=0., do_not_log=.true.) + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (MLE_front_length>0.) + + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + + if (CS%Resoln_use_ebt .or. CS%khth_use_ebt_struct) then + in_use = .true. + call get_param(param_file, mdl, "RESOLN_N2_FILTER_DEPTH", N2_filter_depth, & "The depth below which N2 is monotonized to avoid stratification\n"//& "artifacts from altering the equivalent barotropic mode structure.",& units='m', default=2000.) - endif - if (khth_use_ebt_struct) then allocate(CS%ebt_struct(isd:ied,jsd:jed,G%ke)) ; CS%ebt_struct(:,:,:) = 0.0 endif - if (use_variable_mixing) then - call get_param(param_file, mod, "VISBECK_MAX_SLOPE", CS%Visbeck_S_max, & + + if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then + CS%calculate_Eady_growth_rate = .true. + call get_param(param_file, mdl, "VISBECK_MAX_SLOPE", CS%Visbeck_S_max, & "If non-zero, is an upper bound on slopes used in the\n"// & "Visbeck formula for diffusivity. This does not affect the\n"// & "isopycnal slope calculation used within thickness diffusion.", & units="nondim", default=0.0) endif -! Allocate CS and memory if (CS%use_stored_slopes) then + in_use = .true. allocate(CS%slope_x(IsdB:IedB,jsd:jed,G%ke+1)) ; CS%slope_x(:,:,:) = 0.0 allocate(CS%slope_y(isd:ied,JsdB:JedB,G%ke+1)) ; CS%slope_y(:,:,:) = 0.0 - call get_param(param_file, mod, "KD_SMOOTH", CS%kappa_smooth, & + call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & default=1.0e-6) endif - if (CS%use_variable_mixing) then + if (CS%calculate_Eady_growth_rate) then + in_use = .true. allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 - allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = 0.0 - allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 - call MOM_mesg("VarMix_init: memory allocated for use_variable_mixing", 5) - - ! More run-time parameters - call get_param(param_file, mod, "VARMIX_KTOP", CS%VarMix_Ktop, & + CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & + 'Inverse eddy time-scale, S*N, at u-points', 's^-1') + CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & + 'Inverse eddy time-scale, S*N, at v-points', 's^-1') + call get_param(param_file, mdl, "VARMIX_KTOP", CS%VarMix_Ktop, & "The layer number at which to start vertical integration \n"//& "of S*N for purposes of finding the Eady growth rate.", & units="nondim", default=2) - call get_param(param_file, mod, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & + endif + + if (KhTr_Slope_Cff>0. .or. KhTh_Slope_Cff>0.) then + in_use = .true. + call get_param(param_file, mdl, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & "The fixed length scale in the Visbeck formula.", units="m", & default=0.0) + allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = CS%Visbeck_L_scale**2 + allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = CS%Visbeck_L_scale**2 - ! Register fields for output from this module. - CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & - 'Inverse eddy time-scale, S*N, at u-points', 's^-1') - CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & - 'Inverse eddy time-scale, S*N, at v-points', 's^-1') CS%id_L2u = register_diag_field('ocean_model', 'L2u', diag%axesCu1, Time, & 'Length scale squared for mixing coefficient, at u-points', 'm^2') CS%id_L2v = register_diag_field('ocean_model', 'L2v', diag%axesCv1, Time, & 'Length scale squared for mixing coefficient, at v-points', 'm^2') + endif - if (CS%use_stored_slopes) then - CS%id_N2_u = register_diag_field('ocean_model', 'N2_u', diag%axesCui, Time, & + if (CS%use_stored_slopes) then + CS%id_N2_u = register_diag_field('ocean_model', 'N2_u', diag%axesCui, Time, & 'Square of Brunt-Vaisala frequency, N^2, at u-points, as used in Visbeck et al.', 's^-2') - CS%id_N2_v = register_diag_field('ocean_model', 'N2_v', diag%axesCvi, Time, & + CS%id_N2_v = register_diag_field('ocean_model', 'N2_v', diag%axesCvi, Time, & 'Square of Brunt-Vaisala frequency, N^2, at v-points, as used in Visbeck et al.', 's^-2') - CS%id_S2_u = register_diag_field('ocean_model', 'S2_u', diag%axesCu1, Time, & + CS%id_S2_u = register_diag_field('ocean_model', 'S2_u', diag%axesCu1, Time, & 'Depth average square of slope magnitude, S^2, at u-points, as used in Visbeck et al.', 's^-2') - CS%id_S2_v = register_diag_field('ocean_model', 'S2_v', diag%axesCv1, Time, & + CS%id_S2_v = register_diag_field('ocean_model', 'S2_v', diag%axesCv1, Time, & 'Depth average square of slope magnitude, S^2, at v-points, as used in Visbeck et al.', 's^-2') - endif endif - if (CS%Resoln_scaled_Kh .or. Resoln_scaled_KhTh .or. Resoln_scaled_KhTr) then - call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=Resoln_use_ebt, mono_N2_depth=N2_filter_depth) - - ! Allocate and initialize various arrays. + if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then + CS%calculate_Rd_dx = .true. + CS%calculate_res_fns = .true. allocate(CS%Res_fn_h(isd:ied,jsd:jed)) ; CS%Res_fn_h(:,:) = 0.0 allocate(CS%Res_fn_q(IsdB:IedB,JsdB:JedB)) ; CS%Res_fn_q(:,:) = 0.0 allocate(CS%Res_fn_u(IsdB:IedB,jsd:jed)) ; CS%Res_fn_u(:,:) = 0.0 allocate(CS%Res_fn_v(isd:ied,JsdB:JedB)) ; CS%Res_fn_v(:,:) = 0.0 - allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 - allocate(CS%beta_dx2_h(isd:ied,jsd:jed)) ; CS%beta_dx2_h(:,:) = 0.0 allocate(CS%beta_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%beta_dx2_q(:,:) = 0.0 allocate(CS%beta_dx2_u(IsdB:IedB,jsd:jed)) ; CS%beta_dx2_u(:,:) = 0.0 allocate(CS%beta_dx2_v(isd:ied,JsdB:JedB)) ; CS%beta_dx2_v(:,:) = 0.0 - allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 allocate(CS%f2_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%f2_dx2_q(:,:) = 0.0 allocate(CS%f2_dx2_u(IsdB:IedB,jsd:jed)) ; CS%f2_dx2_u(:,:) = 0.0 allocate(CS%f2_dx2_v(isd:ied,JsdB:JedB)) ; CS%f2_dx2_v(:,:) = 0.0 - allocate(CS%Rd_dx_h(isd:ied,jsd:jed)) ; CS%Rd_dx_h(:,:) = 0.0 CS%id_Res_fn = register_diag_field('ocean_model', 'Res_fn', diag%axesT1, Time, & 'Resolution function for scaling diffusivities', 'Nondim') - CS%id_Rd_dx = register_diag_field('ocean_model', 'Rd_dx', diag%axesT1, Time, & - 'Ratio between deformation radius and grid spacing', 'Nondim') - call get_param(param_file, mod, "KH_RES_SCALE_COEF", CS%Res_coef_khth, & + call get_param(param_file, mdl, "KH_RES_SCALE_COEF", CS%Res_coef_khth, & "A coefficient that determines how KhTh is scaled away if \n"//& "RESOLN_SCALED_... is true, as \n"//& "F = 1 / (1 + (KH_RES_SCALE_COEF*Rd/dx)^KH_RES_FN_POWER).", & units="nondim", default=1.0) - call get_param(param_file, mod, "KH_RES_FN_POWER", CS%Res_fn_power_khth, & + call get_param(param_file, mdl, "KH_RES_FN_POWER", CS%Res_fn_power_khth, & "The power of dx/Ld in the Kh resolution function. Any \n"//& "positive integer may be used, although even integers \n"//& "are more efficient to calculate. Setting this greater \n"//& "than 100 results in a step-function being used.", & units="nondim", default=2) - call get_param(param_file, mod, "VISC_RES_SCALE_COEF", CS%Res_coef_visc, & + call get_param(param_file, mdl, "VISC_RES_SCALE_COEF", CS%Res_coef_visc, & "A coefficient that determines how Kh is scaled away if \n"//& "RESOLN_SCALED_... is true, as \n"//& "F = 1 / (1 + (KH_RES_SCALE_COEF*Rd/dx)^KH_RES_FN_POWER).\n"//& "This function affects lateral viscosity, Kh, and not KhTh.", & units="nondim", default=CS%Res_coef_khth) - call get_param(param_file, mod, "VISC_RES_FN_POWER", CS%Res_fn_power_visc, & + call get_param(param_file, mdl, "VISC_RES_FN_POWER", CS%Res_fn_power_visc, & "The power of dx/Ld in the Kh resolution function. Any \n"//& "positive integer may be used, although even integers \n"//& "are more efficient to calculate. Setting this greater \n"//& "than 100 results in a step-function being used.\n"//& "This function affects lateral viscosity, Kh, and not KhTh.", & units="nondim", default=CS%Res_fn_power_khth) - call get_param(param_file, mod, "INTERPOLATE_RES_FN", CS%interpolate_Res_fn, & + call get_param(param_file, mdl, "INTERPOLATE_RES_FN", CS%interpolate_Res_fn, & "If true, interpolate the resolution function to the \n"//& "velocity points from the thickness points; otherwise \n"//& "interpolate the wave speed and calculate the resolution \n"//& "function independently at each point.", default=.true.) - call get_param(param_file, mod, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & + call get_param(param_file, mdl, "USE_VISBECK_SLOPE_BUG", CS%use_Visbeck_slope_bug, & "If true, then retain a legacy bug in the calculation of weights \n"//& "applied to isoneutral slopes. There was an erroneous k-indexing \n"//& "for layer thicknesses. In addition, masking at coastlines was not \n"//& @@ -944,28 +941,17 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) "MOM_lateral_mixing_coeffs.F90, VarMix_init:"//& "When INTERPOLATE_RES_FN=True, VISC_RES_FN_POWER must equal KH_RES_FN_POWER.") endif - call get_param(param_file, mod, "GILL_EQUATORIAL_LD", Gill_equatorial_Ld, & + call get_param(param_file, mdl, "GILL_EQUATORIAL_LD", Gill_equatorial_Ld, & "If true, uses Gill's definition of the baroclinic\n"//& "equatorial deformation radius, otherwise, if false, use\n"//& "Pedlosky's definition. These definitions differ by a factor\n"//& "of 2 infront of the beta term in the denominator. Gill's"//& "is the more appropriate definition.\n", default=.false.) - - ! Pre-calculate several static expressions for later use. - if (Gill_equatorial_Ld) then; oneOrTwo = 2.0 - else; oneOrTwo = 1.0; endif - - do j=js-1,je+1 ; do i=is-1,ie+1 - CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & - max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & - (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & - absurdly_small_freq2) - CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & - ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & - ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & - (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & - ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) - enddo ; enddo + if (Gill_equatorial_Ld) then + oneOrTwo = 2.0 + else + oneOrTwo = 1.0 + endif do J=js-1,Jeq ; do I=is-1,Ieq CS%f2_dx2_q(I,J) = (G%dxBu(I,J)**2 + G%dyBu(I,J)**2) * & @@ -1001,6 +987,43 @@ subroutine VarMix_init(Time, G, param_file, diag, CS) endif + ! Resolution %Rd_dx_h + CS%id_Rd_dx = register_diag_field('ocean_model', 'Rd_dx', diag%axesT1, Time, & + 'Ratio between deformation radius and grid spacing', 'Nondim') + CS%calculate_Rd_dx = CS%calculate_Rd_dx .or. (CS%id_Rd_dx>0) + + if (CS%calculate_Rd_dx) then + CS%calculate_cg1 = .true. ! We will need %cg1 + allocate(CS%Rd_dx_h(isd:ied,jsd:jed)) ; CS%Rd_dx_h(:,:) = 0.0 + allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 + allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 + do j=js-1,je+1 ; do i=is-1,ie+1 + CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & + max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & + (G%CoriolisBu(I-1,J)**2 + G%CoriolisBu(I,J-1)**2)), & + absurdly_small_freq2) + CS%beta_dx2_h(i,j) = oneOrTwo * (G%dxT(i,j)**2 + G%dyT(i,j)**2) * (sqrt(0.5 * & + ( (((G%CoriolisBu(I,J)-G%CoriolisBu(I-1,J)) * G%IdxCv(i,J))**2 + & + ((G%CoriolisBu(I,J-1)-G%CoriolisBu(I-1,J-1)) * G%IdxCv(i,J-1))**2) + & + (((G%CoriolisBu(I,J)-G%CoriolisBu(I,J-1)) * G%IdyCu(I,j))**2 + & + ((G%CoriolisBu(I-1,J)-G%CoriolisBu(I-1,J-1)) * G%IdyCu(I-1,j))**2) ) )) + enddo ; enddo + endif + + if (CS%calculate_cg1) then + in_use = .true. + allocate(CS%cg1(isd:ied,jsd:jed)); CS%cg1(:,:) = 0.0 + call wave_speed_init(CS%wave_speed_CSp, use_ebt_mode=CS%Resoln_use_ebt, mono_N2_depth=N2_filter_depth) + endif + + ! If nothing is being stored in this class then deallocate + if (in_use) then + CS%use_variable_mixing = .true. + else + deallocate(CS) + return + endif + end subroutine VarMix_init !> \namespace mom_lateral_mixing_coeffs diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index e4b2b50554..e76cbad338 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -1,9 +1,4 @@ -!> This module implements a parameterization of unresolved viscous -!! mixed layer restratification of the mixed layer as described in -!! Fox-Kemper, Ferrari and Hallberg (JPO, 2008), and -!! whose impacts are described in Fox-Kemper et al. -!! (Ocean Modelling). - +!> \brief Parameterization of mixed layer restratification by unresolved mixed-layer eddies. module MOM_mixed_layer_restrat ! This file is part of MOM6. See LICENSE.md for the license. @@ -19,6 +14,7 @@ module MOM_mixed_layer_restrat use MOM_grid, only : ocean_grid_type use MOM_hor_index, only : hor_index_type use MOM_io, only : vardesc, var_desc +use MOM_lateral_mixing_coeffs, only : VarMix_CS use MOM_restart, only : register_restart_field, MOM_restart_CS use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -32,7 +28,7 @@ module MOM_mixed_layer_restrat public mixedlayer_restrat_init public mixedlayer_restrat_register_restarts -!> Control structure for module +!> Control structure for mom_mixed_layer_restrat type, public :: mixedlayer_restrat_CS ; private real :: ml_restrat_coef !< A non-dimensional factor by which the !! instability is enhanced over what would be @@ -40,6 +36,10 @@ module MOM_mixed_layer_restrat !! increases with grid spacing^2, up to something !! of order 500. real :: ml_restrat_coef2 !< As for ml_restrat_coef but using the slow filtered MLD. + real :: front_length !< If non-zero, is the frontal-length scale used to calculate the + !! upscaling of buoyancy gradients that is otherwise represented + !! by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is + !! non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0. logical :: MLE_use_PBL_MLD !< If true, use the MLD provided by the PBL parameterization. !! if false, MLE will calculate a MLD based on a density difference !! based on the parameter MLE_DENSITY_DIFF. @@ -47,7 +47,7 @@ module MOM_mixed_layer_restrat real :: MLE_MLD_decay_time2 !< Time-scale to use in a running-mean when filtered MLD is retreating (s). real :: MLE_density_diff !< Density difference used in detecting mixed-layer !! depth (kg/m3). - real :: MLE_tail_dh !< Fraction by which to extend the mixed-layer re-stratification + real :: 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. real :: MLE_MLD_stretch !< A scaling coefficient for stretching/shrinking the MLD @@ -61,8 +61,10 @@ module MOM_mixed_layer_restrat MLD_filtered => NULL(), & !< Time-filtered MLD (H units) MLD_filtered_slow => NULL() !< Slower time-filtered MLD (H units) - integer :: id_urestrat_time - integer :: id_vrestrat_time + !>@{ + !! Diagnostic identifier + integer :: id_urestrat_time = -1 + integer :: id_vrestrat_time = -1 integer :: id_uhml = -1 integer :: id_vhml = -1 integer :: id_MLD = -1 @@ -71,27 +73,29 @@ module MOM_mixed_layer_restrat integer :: id_vDml = -1 integer :: id_uml = -1 integer :: id_vml = -1 + !>@} end type mixedlayer_restrat_CS -character(len=40) :: mod = "MOM_mixed_layer_restrat" ! This module's name. +character(len=40) :: mdl = "MOM_mixed_layer_restrat" !< This module's name. contains -!> This subroutine does interface depth diffusion. The fluxes are -!! limited to give positive definiteness, and the diffusivities are -!! limited to guarantee stability. -subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, fluxes, dt, MLD, G, GV, CS) - 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_(G)), intent(inout) :: h !< layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated merid mass flux (m3 or kg) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic variables structure - type(forcing), intent(in) :: fluxes !< pointers to forcing fields - real, intent(in) :: dt !< time increment (sec) - real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by PBL (H units) - type(mixedlayer_restrat_CS), pointer :: CS !< module control structure +!> 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, fluxes, dt, MLD, VarMix, G, GV, CS) + 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_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(forcing), intent(in) :: fluxes !< Pointers to forcing fields + real, intent(in) :: dt !< Time increment (sec) + real, dimension(:,:), pointer :: MLD !< Mixed layer depth provided by PBL scheme (H units) + type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure if (.not. associated(CS)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "Module must be initialized before it is used.") @@ -99,27 +103,25 @@ subroutine mixedlayer_restrat(h, uhtr, vhtr, tv, fluxes, dt, MLD, G, GV, CS) if (GV%nkml>0) then call mixedlayer_restrat_BML(h, uhtr, vhtr, tv, fluxes, dt, G, GV, CS) else - call mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD, G, GV, CS) + call mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD, VarMix, G, GV, CS) endif end subroutine mixedlayer_restrat - -!> This subroutine does interface depth diffusion. The fluxes are -!! limited to give positive definiteness, and the diffusivities are -!! limited to guarantee stability. -subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, GV, CS) +!> Calculates a restratifying flow in the mixed layer. +subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, VarMix, G, GV, CS) ! Arguments - 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_(G)), intent(inout) :: h !< layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated merid mass flux (m3 or kg) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic variables structure - type(forcing), intent(in) :: fluxes !< pointers to forcing fields - real, intent(in) :: dt !< time increment (sec) - real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by PBL (H units) - type(mixedlayer_restrat_CS), pointer :: CS !< module control structure + 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_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(forcing), intent(in) :: fluxes !< Pointers to forcing fields + real, intent(in) :: dt !< Time increment (sec) + real, dimension(:,:), pointer :: MLD_in !< Mixed layer depth provided by PBL scheme (H units) + type(VarMix_CS), pointer :: VarMix !< Container for derived fields + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport (m3/s or kg/s) real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport (m3/s or kg/s) @@ -147,7 +149,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, real :: dz_neglect ! A tiny thickness (in m) that is usually lost in roundoff so can be neglected real :: I4dt ! 1/(4 dt) (sec-1) real :: Ihtot,Ihtot_slow! total mixed layer thickness - real :: a(SZK_(G)) ! A nondimensional value relating the overall flux + real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. @@ -165,8 +167,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, real, dimension(SZI_(G)) :: rhoSurf, deltaRhoAtKm1, deltaRhoAtK, dK, dKm1, pRef_MLD ! Used for MLD real, dimension(SZI_(G)) :: rhoAtK, rho1, d1, pRef_N2 ! Used for N2 real :: aFac, bFac, ddRho - real :: hAtVel, zpa, zpb, dh - logical :: proper_averaging, line_is_empty, keep_going + real :: hAtVel, zpa, zpb, dh, res_scaling_fac, I_l_f + logical :: proper_averaging, line_is_empty, keep_going, res_upscale real :: PSI, PSI1, z, BOTTOP, XP, DD ! For the following statement functions ! Stream function as a function of non-dimensional position within mixed-layer (F77 statement function) @@ -182,6 +184,8 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, if (.not.associated(tv%eqn_of_state)) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & "An equation of state must be used with this module.") + if (.not.associated(VarMix) .and. CS%front_length>0.) call MOM_error(FATAL, "MOM_mixedlayer_restrat: "// & + "The resolution argument, Rd/dx, was not associated.") if (CS%MLE_density_diff > 0.) then ! We need to calculate a mixed layer depth, MLD. !! TODO: use derivatives and mid-MLD pressure. Currently this is sigma-0. -AJA @@ -268,15 +272,22 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, h_neglect = GV%H_subroundoff dz_neglect = GV%H_subroundoff*GV%H_to_m proper_averaging = .not. CS%MLE_use_MLD_ave_bug + if (CS%front_length>0.) then + res_upscale = .true. + I_l_f = 1./CS%front_length + else + res_upscale = .false. + endif p0(:) = 0.0 !$OMP parallel default(none) shared(is,ie,js,je,G,GV,htot_fast,Rml_av_fast,tv,p0,h,h_avail,& !$OMP h_neglect,g_Rho0,I4dt,CS,uhml,uhtr,dt,vhml,vhtr, & !$OMP utimescale_diag,vtimescale_diag,fluxes,dz_neglect, & -!$OMP htot_slow,MLD_slow,Rml_av_slow, & +!$OMP htot_slow,MLD_slow,Rml_av_slow,VarMix,I_l_f, & +!$OMP res_upscale, & !$OMP nz,MLD_fast,uDml_diag,vDml_diag,proper_averaging) & !$OMP private(rho_ml,h_vel,u_star,absf,mom_mixrate,timescale, & -!$OMP line_is_empty, keep_going, & +!$OMP line_is_empty, keep_going,res_scaling_fac, & !$OMP a,IhTot,b,Ihtot_slow,zpb,hAtVel,zpa,dh) & !$OMP firstprivate(uDml,vDml,uDml_slow,vDml_slow) !$OMP do @@ -327,13 +338,17 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, ! TO DO: ! 1. Mixing extends below the mixing layer to the mixed layer. Find it! -! 2. Add exponential tail to streamfunction? +! 2. Add exponential tail to stream-function? ! U - Component !$OMP do do j=js,je ; do I=is-1,ie u_star = 0.5*(fluxes%ustar(i,j) + fluxes%ustar(i+1,j)) absf = 0.5*(abs(G%CoriolisBu(I,J-1)) + abs(G%CoriolisBu(I,J))) + ! If needed, res_scaling_fac = min( ds, L_d ) / l_f + if (res_upscale) res_scaling_fac = & + ( sqrt( 0.5 * ( G%dxCu(I,j)**2 + G%dyCu(I,j)**2 ) ) * I_l_f ) & + * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i+1,j) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -343,6 +358,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac uDml(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_fast(i+1,j)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) ! As above but using the slow filtered MLD @@ -351,6 +367,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac uDml_slow(I) = timescale * G%mask2dCu(I,j)*G%dyCu(I,j)* & G%IdxCu(I,j)*(Rml_av_slow(i+1,j)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) @@ -404,6 +421,10 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, do J=js-1,je ; do i=is,ie u_star = 0.5*(fluxes%ustar(i,j) + fluxes%ustar(i,j+1)) absf = 0.5*(abs(G%CoriolisBu(I-1,J)) + abs(G%CoriolisBu(I,J))) + ! If needed, res_scaling_fac = min( ds, L_d ) / l_f + if (res_upscale) res_scaling_fac = & + ( sqrt( 0.5 * ( G%dxCv(i,J)**2 + G%dyCv(i,J)**2 ) ) * I_l_f ) & + * min( 1., 0.5*( VarMix%Rd_dx_h(i,j) + VarMix%Rd_dx_h(i,j+1) ) ) ! peak ML visc: u_star * 0.41 * (h_ml*u_star)/(absf*h_ml + 4.0*u_star) ! momentum mixing rate: pi^2*visc/h_ml^2 @@ -413,6 +434,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef + if (res_upscale) timescale = timescale * res_scaling_fac vDml(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_fast(i,j+1)-Rml_av_fast(i,j)) * (h_vel**2 * GV%m_to_H) ! As above but using the slow filtered MLD @@ -421,6 +443,7 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, (absf*h_vel**2 + 4.0*(h_vel+dz_neglect)*u_star) timescale = 0.0625 * (absf + 2.0*mom_mixrate) / (absf**2 + mom_mixrate**2) timescale = timescale * CS%ml_restrat_coef2 + if (res_upscale) timescale = timescale * res_scaling_fac vDml_slow(i) = timescale * G%mask2dCv(i,J)*G%dxCv(i,J)* & G%IdyCv(i,J)*(Rml_av_slow(i,j+1)-Rml_av_slow(i,j)) * (h_vel**2 * GV%m_to_H) @@ -510,20 +533,18 @@ subroutine mixedlayer_restrat_general(h, uhtr, vhtr, tv, fluxes, dt, MLD_in, G, end subroutine mixedlayer_restrat_general -!> This subroutine does interface depth diffusion. The fluxes are -!! limited to give positive definiteness, and the diffusivities are -!! limited to guarantee stability. +!> Calculates a restratifying flow assuming a 2-layer bulk mixed layer. subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, fluxes, dt, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< layer thickness (H units = m or kg/m2) - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< accumulated zonal mass flux (m3 or kg) - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< accumulated merid mass flux (m3 or kg) - type(thermo_var_ptrs), intent(in) :: tv !< thermodynamic variables structure - type(forcing), intent(in) :: fluxes !< pointers to forcing fields - real, intent(in) :: dt !< time increment (sec) - type(mixedlayer_restrat_CS), pointer :: CS !< module control structure - + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness (H units = m or kg/m2) + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Accumulated zonal mass flux (m3 or kg) + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Accumulated meridional mass flux (m3 or kg) + type(thermo_var_ptrs), intent(in) :: tv !< Thermodynamic variables structure + type(forcing), intent(in) :: fluxes !< Pointers to forcing fields + real, intent(in) :: dt !< Time increment (sec) + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + ! Local variables real :: uhml(SZIB_(G),SZJ_(G),SZK_(G)) ! zonal mixed layer transport (m3/s or kg/s) real :: vhml(SZI_(G),SZJB_(G),SZK_(G)) ! merid mixed layer transport (m3/s or kg/s) real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: & @@ -548,7 +569,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, fluxes, dt, G, GV, CS) real :: I2htot ! Twice the total mixed layer thickness at velocity points (H units) real :: z_topx2 ! depth of the top of a layer at velocity points (H units) real :: hx2 ! layer thickness at velocity points (H units) - real :: a(SZK_(G)) ! A nondimensional value relating the overall flux + real :: a(SZK_(G)) ! A non-dimensional value relating the overall flux ! magnitudes (uDml & vDml) to the realized flux in a ! layer. The vertical sum of a() through the pieces of ! the mixed layer must be 0. @@ -610,7 +631,7 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, fluxes, dt, G, GV, CS) ! TO DO: ! 1. Mixing extends below the mixing layer to the mixed layer. Find it! -! 2. Add exponential tail to streamfunction? +! 2. Add exponential tail to stream-function? ! U - Component !$OMP do @@ -744,22 +765,22 @@ subroutine mixedlayer_restrat_BML(h, uhtr, vhtr, tv, fluxes, dt, G, GV, CS) end subroutine mixedlayer_restrat_BML -!> Initialize the mixedlayer restratification module +!> Initialize the mixed layer restratification module logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) - type(time_type), intent(in) :: Time !< current model time - type(ocean_grid_type), intent(inout) :: G !< ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - type(param_file_type), intent(in) :: param_file !< parameter file to parse - type(diag_ctrl), target, intent(inout) :: diag !< regulate diagnostics - type(mixedlayer_restrat_CS), pointer :: CS !< module control structure - + type(time_type), intent(in) :: Time !< Current model time + type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Ocean vertical grid structure + type(param_file_type), intent(in) :: param_file !< Parameter file to parse + type(diag_ctrl), target, intent(inout) :: diag !< Regulate diagnostics + type(mixedlayer_restrat_CS), pointer :: CS !< Module control structure + ! Local variables ! This include declares and sets the variable "version". #include "version_variable.h" character(len=48) :: flux_units ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & "If true, a density-gradient dependent re-stratifying \n"//& "flow is imposed in the mixed layer. Can be used in ALE mode\n"//& "without restriction but in layer mode can only be used if\n"//& @@ -778,8 +799,8 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) CS%MLE_use_PBL_MLD = .false. CS%MLE_MLD_stretch = -9.e9 - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - call get_param(param_file, mod, "FOX_KEMPER_ML_RESTRAT_COEF", CS%ml_restrat_coef, & + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF", CS%ml_restrat_coef, & "A nondimensional coefficient that is proportional to \n"//& "the ratio of the deformation radius to the dominant \n"//& "lengthscale of the submesoscale mixed layer \n"//& @@ -791,40 +812,45 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) ! We use GV%nkml to distinguish between the old and new implementation of MLE. ! The old implementation only works for the layer model with nkml>0. if (GV%nkml==0) then - call get_param(param_file, mod, "FOX_KEMPER_ML_RESTRAT_COEF2", CS%ml_restrat_coef2, & + call get_param(param_file, mdl, "FOX_KEMPER_ML_RESTRAT_COEF2", CS%ml_restrat_coef2, & "As for FOX_KEMPER_ML_RESTRAT_COEF but used in a second application\n"//& "of the MLE restratification parameterization.", units="nondim", default=0.0) - ! We use GV%nkml to distinguish between the old and new implementation of MLE. - call get_param(param_file, mod, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & + call get_param(param_file, mdl, "MLE_FRONT_LENGTH", CS%front_length, & + "If non-zero, is the frontal-length scale used to calculate the\n"//& + "upscaling of buoyancy gradients that is otherwise represented\n"//& + "by the parameter FOX_KEMPER_ML_RESTRAT_COEF. If MLE_FRONT_LENGTH is\n"//& + "non-zero, it is recommended to set FOX_KEMPER_ML_RESTRAT_COEF=1.0.",& + units="m", default=0.0) + call get_param(param_file, mdl, "MLE_USE_PBL_MLD", CS%MLE_use_PBL_MLD, & "If true, the MLE parameterization will use the mixed-layer\n"//& "depth provided by the active PBL parameterization. If false,\n"//& "MLE will estimate a MLD based on a density difference with the\n"//& "surface using the parameter MLE_DENSITY_DIFF.", default=.false.) - call get_param(param_file, mod, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & "The time-scale for a running-mean filter applied to the mixed-layer\n"//& "depth used in the MLE restratification parameterization. When\n"//& "the MLD deepens below the current running-mean the running-mean\n"//& "is instantaneously set to the current MLD.", units="s", default=0.) - call get_param(param_file, mod, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & "The time-scale for a running-mean filter applied to the filtered\n"//& "mixed-layer depth used in a second MLE restratification parameterization.\n"//& "When the MLD deepens below the current running-mean the running-mean\n"//& "is instantaneously set to the current MLD.", units="s", default=0.) if (.not. CS%MLE_use_PBL_MLD) then - call get_param(param_file, mod, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & + call get_param(param_file, mdl, "MLE_DENSITY_DIFF", CS%MLE_density_diff, & "Density difference used to detect the mixed-layer\n"//& "depth used for the mixed-layer eddy parameterization\n"//& "by Fox-Kemper et al. (2010)", units="kg/m3", default=0.03) endif - call get_param(param_file, mod, "MLE_TAIL_DH", CS%MLE_tail_dh, & + call get_param(param_file, mdl, "MLE_TAIL_DH", CS%MLE_tail_dh, & "Fraction by which to extend the mixed-layer restratification\n"//& "depth used for a smoother stream function at the base of\n"//& "the mixed-layer.", units="nondim", default=0.0) - call get_param(param_file, mod, "MLE_MLD_STRETCH", CS%MLE_MLD_stretch, & + call get_param(param_file, mdl, "MLE_MLD_STRETCH", CS%MLE_MLD_stretch, & "A scaling coefficient for stretching/shrinking the MLD\n"//& "used in the MLE scheme. This simply multiplies MLD wherever used.",& units="nondim", default=1.0) - call get_param(param_file, mod, "MLE_USE_MLD_AVE_BUG", CS%MLE_use_MLD_ave_bug, & + call get_param(param_file, mdl, "MLE_USE_MLD_AVE_BUG", CS%MLE_use_MLD_ave_bug, & "If true, do not account for MLD mismatch to interface positions.",& default=.false.) endif @@ -862,7 +888,7 @@ logical function mixedlayer_restrat_init(Time, G, GV, param_file, diag, CS) end function mixedlayer_restrat_init -!> Allocate and regsiter fields in the mixedlayer restratification structure for restarts +!> Allocate and register fields in the mixed layer restratification structure for restarts subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) ! Arguments type(hor_index_type), intent(in) :: HI !< Horizontal index structure @@ -874,7 +900,7 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) logical :: mixedlayer_restrat_init ! Check to see if this module will be used - call get_param(param_file, mod, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & + call get_param(param_file, mdl, "MIXEDLAYER_RESTRAT", mixedlayer_restrat_init, & default=.false., do_not_log=.true.) if (.not. mixedlayer_restrat_init) return @@ -883,9 +909,9 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) "mixedlayer_restrat_register_restarts called with an associated control structure.") allocate(CS) - call get_param(param_file, mod, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME", CS%MLE_MLD_decay_time, & default=0., do_not_log=.true.) - call get_param(param_file, mod, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & + call get_param(param_file, mdl, "MLE_MLD_DECAY_TIME2", CS%MLE_MLD_decay_time2, & default=0., do_not_log=.true.) if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered is used to keep a running mean of the PBL's actively mixed MLD. @@ -906,56 +932,105 @@ end subroutine mixedlayer_restrat_register_restarts !> \namespace mom_mixed_layer_restrat !! -!! The subroutine in this file implements a parameterization of -!! unresolved viscous mixed layer restratification of the mixed layer -!! as described in Fox-Kemper, Ferrari and Hallberg (JPO, 2008), and -!! whose impacts are described in Fox-Kemper et al. (Ocean Modelling, -!! 2011). This is derived in part from the older parameterizaton -!! that is described in Hallberg (Aha Hulikoa, 2003), which this new -!! parameterization surpasses, which in turn is based on the -!! subinertial mixed layer theory of Young (JPO, 1994). There is no -!! net horizontal volume transport due to this parameterization, and -!! no direct effect below the mixed layer. +!! \section mle-module Mixed-layer eddy parameterization module !! -!! This parameterization sets the restratification timescale to agree -!! high-resolution studies of mixed layer restratification. The run-time -!! parameter FOX_KEMPER_ML_RESTRAT_COEF is a nondimensional number -!! of order a few tens, proportional to the ratio of the deformation -!! radius or the gridscale (whichever is smaller to the dominant -!! horizontal lengthscale of the submesoscale mixed layer -!! instabilities. +!! The subroutines in this file implement a parameterization of unresolved viscous +!! mixed layer restratification of the mixed layer as described in Fox-Kemper et +!! al., 2008, and whose impacts are described in Fox-Kemper et al., 2011. +!! This is derived in part from the older parameterization that is described in +!! Hallberg (Aha Hulikoa, 2003), which this new parameterization surpasses, which +!! in turn is based on the sub-inertial mixed layer theory of Young (JPO, 1994). +!! There is no net horizontal volume transport due to this parameterization, and +!! no direct effect below the mixed layer. !! -!! Macros written all in capital letters are defined in MOM_memory.h. +!! This parameterization sets the restratification timescale to agree with +!! high-resolution studies of mixed layer restratification. !! -!! \section section_gridlayout MOM grid layout +!! The run-time parameter FOX_KEMPER_ML_RESTRAT_COEF is a non-dimensional number of +!! order a few tens, proportional to the ratio of the deformation radius or the +!! grid scale (whichever is smaller to the dominant horizontal length-scale of the +!! sub-meso-scale mixed layer instabilities. !! -!! A small fragment of the grid is shown below: +!! \subsection section-submeso-nutshell "Sub-meso" in a nutshell !! -!! \verbatim -!! j+1 x ^ x ^ x +!! The parameterization is colloquially referred to as "sub-meso". !! -!! j+1 > o > o > +!! The original Fox-Kemper et al., (2008b) paper proposed a quasi-Stokes +!! advection described by the stream function (eq. 5 of Fox-Kemper et al., 2011): +!! \f[ +!! {\bf \Psi}_o = C_e \frac{ H^2 \nabla \bar{b} \times \hat{\bf z} }{ |f| } \mu(z) +!! \f] !! -!! j x ^ x ^ x +!! where the vertical profile function is +!! \f[ +!! \mu(z) = \max \left\{ 0, \left[ 1 - \left(\frac{2z}{H}+1\right)^2 \right] +!! \left[ 1 + \frac{5}{21} \left(\frac{2z}{H}+1\right)^2 \right] \right\} +!! \f] +!! and \f$ H \f$ is the mixed-layer depth, \f$ f \f$ is the local Coriolis parameter, \f$ C_e \sim 0.06-0.08 \f$ and +!! \f$ \nabla \bar{b} \f$ is a depth mean buoyancy gradient averaged over the mixed layer. !! -!! j > o > o > +!! For use in coarse-resolution models, an upscaling of the buoyancy gradients and adaption for the equator +!! leads to the following parameterization (eq. 6 of Fox-Kemper et al., 2011): +!! \f[ +!! {\bf \Psi} = C_e \Gamma_\Delta \frac{\Delta s}{l_f} \frac{ H^2 \nabla \bar{b} \times \hat{\bf z} }{ \sqrt{ f^2 + \tau^{-2}} } \mu(z) +!! \f] +!! where \f$ \Delta s \f$ is the minimum of grid-scale and deformation radius, +!! \f$ l_f \f$ is the width of the mixed-layer fronts, and \f$ \Gamma_\Delta=1 \f$. +!! \f$ \tau \f$ is a time-scale for mixing momentum across the mixed layer. +!! \f$ l_f \f$ is thought to be of order hundreds of meters. !! -!! j-1 x ^ x ^ x +!! The upscaling factor \f$ \frac{\Delta s}{l_f} \f$ can be a global constant, model parameter FOX_KEMPER_ML_RESTRAT, +!! so that in practice the parameterization is: +!! \f[ +!! {\bf \Psi} = C_e \Gamma_\Delta \frac{ H^2 \nabla \bar{b} \times \hat{\bf z} }{ \sqrt{ f^2 + \tau^{-2}} } \mu(z) +!! \f] +!! with non-unity \f$ \Gamma_\Delta \f$. !! -!! i-1 i i+1 +!! \f$ C_e \f$ is hard-coded as 0.0625. \f$ \tau \f$ is calculated from the surface friction velocity \f$ u^* \f$. +!! \todo Explain expression for momentum mixing time-scale. !! -!! i i+1 +!! \subsection section-mle-filtering Time-filtering of mixed-layer depth !! -!! \endverbatim +!! Using the instantaneous mixed-layer depth is inconsistent with the finite life-time of +!! mixed-layer instabilities. We provide a one-sided running-mean filter of mixed-layer depth, \f$ H \f$, of the form: +!! \f[ +!! \bar{H} \leftarrow \max \left( H, \frac{ \Delta t H + \tau_h \bar{H} }{ \Delta t + \tau_h } \right) +!! \f] +!! which allows the effective mixed-layer depth seen by the parameterization, $\bar{H}$, to instantaneously deepen +!! but to decay with time-scale \f$ \tau_h \f$. +!! \f$ \bar{H} \f$ is substituted for \f$ H \f$ in the above equations. !! -!! Fields at each point -!! * x = q, CoriolisBu -!! * ^ = v, PFv, CAv, vh, diffv, tauy, vbt, vhtr -!! * > = u, PFu, CAu, uh, diffu, taux, ubt, uhtr -!! * o = h, bathyT, eta, T, S, tr +!! \subsection section-mle-mld Defining the mixed-layer-depth !! -!! The boundaries always run through q grid points (x). +!! If the parameter MLE_USE_PBL_MLD=True then the mixed-layer depth is defined/diagnosed by the +!! boundary-layer parameterization (e.g. ePBL, KPP, etc.). !! - +!! If the parameter MLE_USE_PBL_MLD=False then the mixed-layer depth is diagnosed in this module +!! as the depth of a given density difference, \f$ \Delta \rho \f$, with the surface where the +!! density difference is the parameter MLE_DENSITY_DIFF. +!! +!! \subsection section-mle-ref References +!! +!! Fox-Kemper, B., Ferrari, R. and Hallberg, R., 2008: +!! Parameterization of Mixed Layer Eddies. Part I: Theory and Diagnosis +!! J. Phys. Oceangraphy, 38 (6), p1145-1165. +!! https://doi.org/10.1175/2007JPO3792.1 +!! +!! Fox-Kemper, B. and Ferrari, R. 2008: +!! Parameterization of Mixed Layer Eddies. Part II: Prognosis and Impact +!! J. Phys. Oceangraphy, 38 (6), p1166-1179. +!! https://doi.org/10.1175/2007JPO3788.1 +!! +!! B. Fox-Kemper, G. Danabasoglu, R. Ferrari, S.M. Griffies, R.W. Hallberg, M.M. Holland, M.E. Maltrud, S. Peacock, and B.L. Samuels, 2011: +!! Parameterization of mixed layer eddies. III: Implementation and impact in global ocean climate simulations. +!! Ocean Modell., 39(1), p61-78. +!! https://doi.org/10.1016/j.ocemod.2010.09.002 +!! +!! | Symbol | Module parameter | +!! | ---------------------------- | --------------------- | +!! | \f$ \Gamma_\Delta \f$ | FOX_KEMPER_ML_RESTRAT | +!! | \f$ l_f \f$ | MLE_FRONT_LENGTH | +!! | \f$ \tau_h \f$ | MLE_MLD_DECAY_TIME | +!! | \f$ \Delta \rho \f$ | MLE_DENSITY_DIFF | end module MOM_mixed_layer_restrat diff --git a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 index d22dbe07c0..0d658bbaf6 100644 --- a/src/parameterizations/lateral/MOM_thickness_diffuse.F90 +++ b/src/parameterizations/lateral/MOM_thickness_diffuse.F90 @@ -141,7 +141,7 @@ subroutine thickness_diffuse(h, uhtr, vhtr, tv, dt, G, GV, MEKE, VarMix, CDp, CS use_VarMix = .false. ; Resoln_scaled = .false. ; use_stored_slopes = .false. khth_use_ebt_struct = .false. if (Associated(VarMix)) then - use_VarMix = VarMix%use_variable_mixing + use_VarMix = VarMix%use_variable_mixing .and. (CS%KHTH_Slope_Cff > 0.) Resoln_scaled = VarMix%Resoln_scaled_KhTh use_stored_slopes = VarMix%use_stored_slopes khth_use_ebt_struct = VarMix%khth_use_ebt_struct @@ -1673,7 +1673,7 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_thickness_diffuse" ! This module's name. + character(len=40) :: mdl = "MOM_thickness_diffuse" ! This module's name. character(len=48) :: flux_units real :: omega, strat_floor @@ -1686,70 +1686,70 @@ subroutine thickness_diffuse_init(Time, G, GV, param_file, diag, CDp, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "THICKNESSDIFFUSE", CS%thickness_diffuse, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "THICKNESSDIFFUSE", CS%thickness_diffuse, & "If true, interface heights are diffused with a \n"//& "coefficient of KHTH.", default=.false.) - call get_param(param_file, mod, "KHTH", CS%Khth, & + call get_param(param_file, mdl, "KHTH", CS%Khth, & "The background horizontal thickness diffusivity.", & units = "m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & + call get_param(param_file, mdl, "KHTH_SLOPE_CFF", CS%KHTH_Slope_Cff, & "The nondimensional coefficient in the Visbeck formula \n"//& "for the interface depth diffusivity", units="nondim", & default=0.0) - call get_param(param_file, mod, "KHTH_MIN", CS%KHTH_Min, & + call get_param(param_file, mdl, "KHTH_MIN", CS%KHTH_Min, & "The minimum horizontal thickness diffusivity.", & units = "m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTH_MAX", CS%KHTH_Max, & + call get_param(param_file, mdl, "KHTH_MAX", CS%KHTH_Max, & "The maximum horizontal thickness diffusivity.", & units = "m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTH_MAX_CFL", CS%max_Khth_CFL, & + call get_param(param_file, mdl, "KHTH_MAX_CFL", CS%max_Khth_CFL, & "The maximum value of the local diffusive CFL ratio that \n"//& "is permitted for the thickness diffusivity. 1.0 is the \n"//& "marginally unstable value in a pure layered model, but \n"//& "much smaller numbers (e.g. 0.1) seem to work better for \n"//& "ALE-based models.", units = "nondimensional", default=0.8) if (CS%max_Khth_CFL < 0.0) CS%max_Khth_CFL = 0.0 - call get_param(param_file, mod, "DETANGLE_INTERFACES", CS%detangle_interfaces, & + call get_param(param_file, mdl, "DETANGLE_INTERFACES", CS%detangle_interfaces, & "If defined add 3-d structured enhanced interface height \n"//& "diffusivities to horizonally smooth jagged layers.", & default=.false.) CS%detangle_time = 0.0 if (CS%detangle_interfaces) & - call get_param(param_file, mod, "DETANGLE_TIMESCALE", CS%detangle_time, & + call get_param(param_file, mdl, "DETANGLE_TIMESCALE", CS%detangle_time, & "A timescale over which maximally jagged grid-scale \n"//& "thickness variations are suppressed. This must be \n"//& "longer than DT, or 0 to use DT.", units = "s", default=0.0) - call get_param(param_file, mod, "KHTH_SLOPE_MAX", CS%slope_max, & + call get_param(param_file, mdl, "KHTH_SLOPE_MAX", CS%slope_max, & "A slope beyond which the calculated isopycnal slope is \n"//& "not reliable and is scaled away.", units="nondim", default=0.01) - call get_param(param_file, mod, "KD_SMOOTH", CS%kappa_smooth, & + call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate \n"//& "more sensible values of T & S into thin layers.", & default=1.0e-6) - call get_param(param_file, mod, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & + call get_param(param_file, mdl, "KHTH_USE_FGNV_STREAMFUNCTION", CS%use_FGNV_streamfn, & "If true, use the streamfunction formulation of\n"// & "Ferrari et al., 2010, which effectively emphasizes\n"//& "graver vertical modes by smoothing in the vertical.", & default=.false.) - call get_param(param_file, mod, "FGNV_FILTER_SCALE", CS%FGNV_scale, & + call get_param(param_file, mdl, "FGNV_FILTER_SCALE", CS%FGNV_scale, & "A coefficient scaling the vertical smoothing term in the\n"//& "Ferrari et al., 2010, streamfunction formulation.", & default=1., do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mod, "FGNV_C_MIN", CS%FGNV_c_min, & + call get_param(param_file, mdl, "FGNV_C_MIN", CS%FGNV_c_min, & "A minium wave speed used in the Ferrari et al., 2010,\n"//& "streamfunction formulation.", & default=0., units="m s-1", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mod, "FGNV_STRAT_FLOOR", strat_floor, & + call get_param(param_file, mdl, "FGNV_STRAT_FLOOR", strat_floor, & "A floor for Brunt-Vasaila frequency in the Ferrari et al., 2010,\n"//& "streamfunction formulation, expressed as a fraction of planetary\n"//& "rotation, OMEGA. This should be tiny but non-zero to avoid degeneracy.", & default=1.e-15, units="nondim", do_not_log=.not.CS%use_FGNV_streamfn) - call get_param(param_file, mod, "OMEGA",omega, & + call get_param(param_file, mdl, "OMEGA",omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5, do_not_log=.not.CS%use_FGNV_streamfn) if (CS%use_FGNV_streamfn) CS%N2_floor = (strat_floor*omega)**2 - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 27d8c3cadf..385a99b683 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -50,12 +50,14 @@ module MOM_tidal_forcing !* * !*********************************************************************** -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, CLOCK_MODULE +use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end, & + CLOCK_MODULE +use MOM_domains, only : pass_var use MOM_error_handler, only : MOM_error, FATAL, WARNING -use MOM_file_parser, only : get_param, log_version, param_file_type -use MOM_grid, only : ocean_grid_type -use MOM_io, only : field_exists, file_exists, read_data -use MOM_time_manager, only : time_type, time_type_to_real +use MOM_file_parser, only : get_param, log_version, param_file_type +use MOM_grid, only : ocean_grid_type +use MOM_io, only : field_exists, file_exists, read_data +use MOM_time_manager, only : time_type, time_type_to_real implicit none ; private @@ -102,11 +104,18 @@ module MOM_tidal_forcing contains +!> This subroutine allocates space for the static variables used +!! by this module. The metrics may be effectively 0, 1, or 2-D arrays, +!! while fields like the background viscosities are 2-D arrays. +!! ALLOC is a macro defined in MOM_memory.h for allocate or nothing with +!! static memory. subroutine tidal_forcing_init(Time, G, param_file, CS) - type(time_type), intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(tidal_forcing_CS), pointer :: CS + type(time_type), intent(in) :: Time !< The current model time. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(tidal_forcing_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. ! This subroutine allocates space for the static variables used ! by this module. The metrics may be effectively 0, 1, or 2-D arrays, @@ -132,7 +141,7 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) logical :: FAIL_IF_MISSING = .true. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_tidal_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_tidal_forcing" ! This module's name. character(len=128) :: mesg character(len=200) :: tidal_input_files(4*MAX_CONSTITUENTS) integer :: i, j, c, is, ie, js, je, isd, ied, jsd, jed, nc @@ -146,8 +155,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "TIDES", tides, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "TIDES", tides, & "If true, apply tidal momentum forcing.", default=.false.) if (.not.tides) return @@ -164,51 +173,51 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) lon_rad(i,j) = G%geoLonT(i,j)*deg_to_rad enddo ; enddo do j=js-1,je+1 ; do i=is-1,ie+1 - CS%sin_struct(i,j,1) = -sin(2.0*lat_rad(i,j)) * cos(lon_rad(i,j)) - CS%cos_struct(i,j,1) = sin(2.0*lat_rad(i,j)) * sin(lon_rad(i,j)) + CS%sin_struct(i,j,1) = -sin(2.0*lat_rad(i,j)) * sin(lon_rad(i,j)) + CS%cos_struct(i,j,1) = sin(2.0*lat_rad(i,j)) * cos(lon_rad(i,j)) CS%sin_struct(i,j,2) = -cos(lat_rad(i,j))**2 * sin(2.0*lon_rad(i,j)) - CS%cos_struct(i,j,2) = cos(lat_rad(i,j))**2 * cos(2.0*lon_rad(i,j)) - CS%sin_struct(i,j,3) = 0.0 + CS%cos_struct(i,j,2) = cos(lat_rad(i,j))**2 * cos(2.0*lon_rad(i,j)) + CS%sin_struct(i,j,3) = 0.0 CS%cos_struct(i,j,3) = (0.5-1.5*sin(lat_rad(i,j))**2) enddo ; enddo - call get_param(param_file, mod, "TIDE_M2", use_M2, & + call get_param(param_file, mdl, "TIDE_M2", use_M2, & "If true, apply tidal momentum forcing at the M2 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_S2", use_S2, & + call get_param(param_file, mdl, "TIDE_S2", use_S2, & "If true, apply tidal momentum forcing at the S2 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_N2", use_N2, & + call get_param(param_file, mdl, "TIDE_N2", use_N2, & "If true, apply tidal momentum forcing at the N2 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_K2", use_K2, & + call get_param(param_file, mdl, "TIDE_K2", use_K2, & "If true, apply tidal momentum forcing at the K2 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_K1", use_K1, & + call get_param(param_file, mdl, "TIDE_K1", use_K1, & "If true, apply tidal momentum forcing at the K1 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_O1", use_O1, & + call get_param(param_file, mdl, "TIDE_O1", use_O1, & "If true, apply tidal momentum forcing at the O1 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_P1", use_P1, & + call get_param(param_file, mdl, "TIDE_P1", use_P1, & "If true, apply tidal momentum forcing at the P1 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_Q1", use_Q1, & + call get_param(param_file, mdl, "TIDE_Q1", use_Q1, & "If true, apply tidal momentum forcing at the Q1 \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_MF", use_MF, & + call get_param(param_file, mdl, "TIDE_MF", use_MF, & "If true, apply tidal momentum forcing at the MF \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) - call get_param(param_file, mod, "TIDE_MM", use_MM, & + call get_param(param_file, mdl, "TIDE_MM", use_MM, & "If true, apply tidal momentum forcing at the MM \n"//& "frequency. This is only used if TIDES is true.", & default=.false.) @@ -228,21 +237,21 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) return endif - call get_param(param_file, mod, "TIDAL_SAL_FROM_FILE", CS%tidal_sal_from_file, & + call get_param(param_file, mdl, "TIDAL_SAL_FROM_FILE", CS%tidal_sal_from_file, & "If true, read the tidal self-attraction and loading \n"//& "from input files, specified by TIDAL_INPUT_FILE. \n"//& "This is only used if TIDES is true.", default=.false.) - call get_param(param_file, mod, "USE_PREVIOUS_TIDES", CS%use_prev_tides, & + call get_param(param_file, mdl, "USE_PREVIOUS_TIDES", CS%use_prev_tides, & "If true, use the SAL from the previous iteration of the \n"//& "tides to facilitate convergent iteration. \n"//& "This is only used if TIDES is true.", default=.false.) - call get_param(param_file, mod, "TIDE_USE_SAL_SCALAR", CS%use_sal_scalar, & + call get_param(param_file, mdl, "TIDE_USE_SAL_SCALAR", CS%use_sal_scalar, & "If true and TIDES is true, use the scalar approximation \n"//& "when calculating self-attraction and loading.", & default=.not.CS%tidal_sal_from_file) ! If it is being used, sal_scalar MUST be specified in param_file. if (CS%use_sal_scalar .or. CS%use_prev_tides) & - call get_param(param_file, mod, "TIDE_SAL_SCALAR_VALUE", CS%sal_scalar, & + call get_param(param_file, mdl, "TIDE_SAL_SCALAR_VALUE", CS%sal_scalar, & "The constant of proportionality between sea surface \n"//& "height (really it should be bottom pressure) anomalies \n"//& "and bottom geopotential anomalies. This is only used if \n"//& @@ -258,7 +267,7 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) do c=1,4*MAX_CONSTITUENTS ; tidal_input_files(c) = "" ; enddo if (CS%tidal_sal_from_file .or. CS%use_prev_tides) then - call get_param(param_file, mod, "TIDAL_INPUT_FILE", tidal_input_files, & + call get_param(param_file, mdl, "TIDAL_INPUT_FILE", tidal_input_files, & "A list of input files for tidal information.", & default = "", fail_if_missing=.true.) endif @@ -339,15 +348,15 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! frequency, amplitude and initial phase of each constituent, and log the ! values that are actually used. do c=1,nc - call get_param(param_file, mod, "TIDE_"//trim(CS%const_name(c))//"_FREQ", CS%freq(c), & + call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_FREQ", CS%freq(c), & "Frequency of the "//trim(CS%const_name(c))//" tidal constituent. \n"//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true.", units="s-1", default=freq_def(c)) - call get_param(param_file, mod, "TIDE_"//trim(CS%const_name(c))//"_AMP", CS%amp(c), & + call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_AMP", CS%amp(c), & "Amplitude of the "//trim(CS%const_name(c))//" tidal constituent. \n"//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true.", units="m", default=amp_def(c)) - call get_param(param_file, mod, "TIDE_"//trim(CS%const_name(c))//"_PHASE_T0", CS%phase0(c), & + call get_param(param_file, mdl, "TIDE_"//trim(CS%const_name(c))//"_PHASE_T0", CS%phase0(c), & "Phase of the "//trim(CS%const_name(c))//" tidal constituent at time 0. \n"//& "This is only used if TIDES and TIDE_"//trim(CS%const_name(c))// & " are true.", units="radians", default=phase0_def(c)) @@ -361,6 +370,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! Read variables with names like PHASE_SAL_M2 and AMP_SAL_M2. call find_in_files(tidal_input_files,"PHASE_SAL_"//trim(CS%const_name(c)),phase,G) call find_in_files(tidal_input_files,"AMP_SAL_"//trim(CS%const_name(c)),CS%ampsal(:,:,c),G) + call pass_var(phase, G%domain,complete=.false.) + call pass_var(CS%ampsal(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 CS%cosphasesal(i,j,c) = cos(phase(i,j)*deg_to_rad) CS%sinphasesal(i,j,c) = sin(phase(i,j)*deg_to_rad) @@ -376,6 +387,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! Read variables with names like PHASE_PREV_M2 and AMP_PREV_M2. call find_in_files(tidal_input_files,"PHASE_PREV_"//trim(CS%const_name(c)),phase,G) call find_in_files(tidal_input_files,"AMP_PREV_"//trim(CS%const_name(c)),CS%amp_prev(:,:,c),G) + call pass_var(phase, G%domain,complete=.false.) + call pass_var(CS%amp_prev(:,:,c),G%domain,complete=.true.) do j=js-1,je+1 ; do i=is-1,ie+1 CS%cosphase_prev(i,j,c) = cos(phase(i,j)*deg_to_rad) CS%sinphase_prev(i,j,c) = sin(phase(i,j)*deg_to_rad) @@ -387,6 +400,7 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) end subroutine tidal_forcing_init +! #@# This subroutine needs a doxygen description. subroutine find_in_files(tidal_input_files,varname,array,G) character(len=*), intent(in) :: tidal_input_files(:) character(len=*), intent(in) :: varname @@ -416,10 +430,15 @@ subroutine find_in_files(tidal_input_files,varname,array,G) end subroutine find_in_files +!> This subroutine calculates returns the partial derivative of the local +!! geopotential height with the input sea surface height due to self-attraction +!! and loading. subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(tidal_forcing_CS), pointer :: CS - real, intent(out) :: deta_tidal_deta + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a previous call to + !! tidal_forcing_init. + real, intent(out) :: deta_tidal_deta !< The partial derivative of eta_tidal with + !! the local value of eta, nondim. ! This subroutine calculates returns the partial derivative of the local ! geopotential height with the input sea surface height due to self-attraction ! and loading. @@ -438,13 +457,24 @@ subroutine tidal_forcing_sensitivity(G, CS, deta_tidal_deta) endif end subroutine tidal_forcing_sensitivity +!> This subroutine calculates the geopotential anomalies that drive the tides, +!! including self-attraction and loading. Optionally, it also returns the +!! partial derivative of the local geopotential height with the input sea surface +!! height. For now, eta and eta_tidal are both geopotential heights in m, but +!! probably the input for eta should really be replaced with the column mass +!! anomalies. subroutine calc_tidal_forcing(Time, eta, eta_tidal, G, CS, deta_tidal_deta) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time - real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta - real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal - type(tidal_forcing_CS), pointer :: CS - real, optional, intent(out) :: deta_tidal_deta + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(time_type), intent(in) :: Time !< The time for the caluculation. + real, dimension(SZI_(G),SZJ_(G)), intent(in) :: eta !< The sea surface height anomaly from + !! a time-mean geoid in m. + real, dimension(SZI_(G),SZJ_(G)), intent(out) :: eta_tidal !< The tidal forcing geopotential + !! anomalies, in m. + type(tidal_forcing_CS), pointer :: CS !< The control structure returned by a + !! previous call to tidal_forcing_init. + real, optional, intent(out) :: deta_tidal_deta !< The partial derivative of + !! eta_tidal with the local value of + !! eta, nondim. ! This subroutine calculates the geopotential anomalies that drive the tides, ! including self-attraction and loading. Optionally, it also returns the diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 82c6fd253b..e778645788 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -101,7 +101,7 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_sponge" ! This module's name. + character(len=40) :: mdl = "MOM_sponge" ! This module's name. logical :: use_sponge real, dimension(SZIB_(G),SZJ_(G),nz_data) :: data_hu !< thickness at u points real, dimension(SZI_(G),SZJB_(G),nz_data) :: data_hv !< thickness at v points @@ -117,8 +117,8 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) endif ! Set default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "SPONGE", use_sponge, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SPONGE", use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) @@ -127,16 +127,16 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) allocate(CS) - call get_param(param_file, mod, "SPONGE_UV", CS%sponge_uv, & + call get_param(param_file, mdl, "SPONGE_UV", CS%sponge_uv, & "Apply sponges in u and v, in addition to tracers.", & default=.false.) - call get_param(param_file, mod, "REMAPPING_SCHEME", remapScheme, & + call get_param(param_file, mdl, "REMAPPING_SCHEME", remapScheme, & "This sets the reconstruction scheme used \n"//& " for vertical remapping for all variables.", & default="PLM", do_not_log=.true.) - call get_param(param_file, mod, "BOUNDARY_EXTRAPOLATION", bndExtrapolation, & + call get_param(param_file, mdl, "BOUNDARY_EXTRAPOLATION", bndExtrapolation, & "When defined, a proper high-order reconstruction \n"//& "scheme is used within boundary cells rather \n"// & "than PCM. E.g., if PPM is used for remapping, a \n" //& @@ -187,7 +187,7 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) ! Call the constructor for remapping control structure call initialize_remapping(CS%remap_cs, remapScheme, boundary_extrapolation=bndExtrapolation) - call log_param(param_file, mod, "!Total sponge columns at h points", total_sponge_cols, & + call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & "The total number of columns where sponges are applied at h points.") if (CS%sponge_uv) then @@ -225,7 +225,7 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) endif total_sponge_cols_u = CS%num_col_u call sum_across_PEs(total_sponge_cols_u) - call log_param(param_file, mod, "!Total sponge columns at u points", total_sponge_cols_u, & + call log_param(param_file, mdl, "!Total sponge columns at u points", total_sponge_cols_u, & "The total number of columns where sponges are applied at u points.") ! v points @@ -262,7 +262,7 @@ subroutine initialize_ALE_sponge(Iresttime, data_h, nz_data, G, param_file, CS) endif total_sponge_cols_v = CS%num_col_v call sum_across_PEs(total_sponge_cols_v) - call log_param(param_file, mod, "!Total sponge columns at v points", total_sponge_cols_v, & + call log_param(param_file, mdl, "!Total sponge columns at v points", total_sponge_cols_v, & "The total number of columns where sponges are applied at v points.") endif diff --git a/src/parameterizations/vertical/MOM_KPP.F90 b/src/parameterizations/vertical/MOM_KPP.F90 index 0b01a44d25..c0fa21fc9e 100644 --- a/src/parameterizations/vertical/MOM_KPP.F90 +++ b/src/parameterizations/vertical/MOM_KPP.F90 @@ -141,7 +141,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) ! Local variables #include "version_variable.h" - character(len=40) :: mod = 'MOM_KPP' ! name of this module + character(len=40) :: mdl = 'MOM_KPP' ! name of this module character(len=20) :: string ! local temporary string logical :: CS_IS_ONE=.false. @@ -150,9 +150,9 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) allocate(CS) ! Read parameters - call log_version(paramFile, mod, version, 'This is the MOM wrapper to CVmix:KPP\n' // & + call log_version(paramFile, mdl, version, 'This is the MOM wrapper to CVmix:KPP\n' // & 'See http://code.google.com/p/cvmix/') - call get_param(paramFile, mod, "USE_KPP", KPP_init, & + call get_param(paramFile, mdl, "USE_KPP", KPP_init, & "If true, turns on the [CVmix] KPP scheme of Large et al., 1994,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false.) @@ -160,81 +160,81 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) if (.not. KPP_init) return call openParameterBlock(paramFile,'KPP') - call get_param(paramFile, mod, 'PASSIVE', CS%passiveMode, & + call get_param(paramFile, mdl, 'PASSIVE', CS%passiveMode, & 'If True, puts KPP into a passive-diagnostic mode.', & default=.False.) if (present(passive)) passive=CS%passiveMode ! This is passed back to the caller so ! the caller knows to not use KPP output - call get_param(paramFile, mod, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, & + call get_param(paramFile, mdl, 'APPLY_NONLOCAL_TRANSPORT', CS%applyNonLocalTrans, & 'If True, applies the non-local transport to heat and scalars.\n'// & 'If False, calculates the non-local transport and tendencies but\n'//& 'purely for diagnostic purposes.', & default=.not. CS%passiveMode) - call get_param(paramFile, mod, 'RI_CRIT', CS%Ri_crit, & + call get_param(paramFile, mdl, 'RI_CRIT', CS%Ri_crit, & 'Critical bulk Richardson number used to define depth of the\n'// & 'surface Ocean Boundary Layer (OBL).', & units='nondim', default=0.3) - call get_param(paramFile, mod, 'VON_KARMAN', CS%vonKarman, & + call get_param(paramFile, mdl, 'VON_KARMAN', CS%vonKarman, & 'von Karman constant.', & units='nondim', default=0.40) - call get_param(paramFile, mod, 'ENHANCE_DIFFUSION', CS%enhance_diffusion, & + call get_param(paramFile, mdl, 'ENHANCE_DIFFUSION', CS%enhance_diffusion, & 'If True, adds enhanced diffusion at the based of the boundary layer.', & default=.true.) - call get_param(paramFile, mod, 'INTERP_TYPE', CS%interpType, & + call get_param(paramFile, mdl, 'INTERP_TYPE', CS%interpType, & 'Type of interpolation to determine the OBL depth.\n'// & 'Allowed types are: linear, quadratic, cubic.', & default='cubic') - call get_param(paramFile, mod, 'COMPUTE_EKMAN', CS%computeEkman, & + call get_param(paramFile, mdl, 'COMPUTE_EKMAN', CS%computeEkman, & 'If True, limit OBL depth to be no deeper than Ekman depth.', & default=.False.) - call get_param(paramFile, mod, 'COMPUTE_MONIN_OBUKHOV', CS%computeMoninObukhov, & + call get_param(paramFile, mdl, 'COMPUTE_MONIN_OBUKHOV', CS%computeMoninObukhov, & 'If True, limit the OBL depth to be no deeper than\n'// & 'Monin-Obukhov depth.', & default=.False.) - call get_param(paramFile, mod, 'CS', CS%cs, & + call get_param(paramFile, mdl, 'CS', CS%cs, & 'Parameter for computing velocity scale function.', & units='nondim', default=98.96) - call get_param(paramFile, mod, 'CS2', CS%cs2, & + call get_param(paramFile, mdl, 'CS2', CS%cs2, & 'Parameter for computing non-local term.', & units='nondim', default=6.32739901508) - call get_param(paramFile, mod, 'DEEP_OBL_OFFSET', CS%deepOBLoffset, & + call get_param(paramFile, mdl, 'DEEP_OBL_OFFSET', CS%deepOBLoffset, & 'If non-zero, the distance above the bottom to which the OBL is clipped\n'// & 'if it would otherwise reach the bottom. The smaller of this and 0.1D is used.', & units='m',default=0.) - call get_param(paramFile, mod, 'FIXED_OBLDEPTH', CS%fixedOBLdepth, & + call get_param(paramFile, mdl, 'FIXED_OBLDEPTH', CS%fixedOBLdepth, & 'If True, fix the OBL depth to FIXED_OBLDEPTH_VALUE\n'// & 'rather than using the OBL depth from CVMix.\n'// & 'This option is just for testing purposes.', & default=.False.) - call get_param(paramFile, mod, 'FIXED_OBLDEPTH_VALUE', CS%fixedOBLdepth_value, & + call get_param(paramFile, mdl, 'FIXED_OBLDEPTH_VALUE', CS%fixedOBLdepth_value, & 'Value for the fixed OBL depth when fixedOBLdepth==True. \n'// & 'This parameter is for just for testing purposes. \n'// & 'It will over-ride the OBLdepth computed from CVMix.', & units='m',default=30.0) - call get_param(paramFile, mod, 'SURF_LAYER_EXTENT', CS%surf_layer_ext, & + call get_param(paramFile, mdl, 'SURF_LAYER_EXTENT', CS%surf_layer_ext, & 'Fraction of OBL depth considered in the surface layer.', & units='nondim',default=0.10) - call get_param(paramFile, mod, 'MINIMUM_OBL_DEPTH', CS%minOBLdepth, & + call get_param(paramFile, mdl, 'MINIMUM_OBL_DEPTH', CS%minOBLdepth, & 'If non-zero, a minimum depth to use for KPP OBL depth. Independent of\n'// & 'this parameter, the OBL depth is always at least as deep as the first layer.', & units='m',default=0.) - call get_param(paramFile, mod, 'MINIMUM_VT2', CS%minVtsqr, & + call get_param(paramFile, mdl, 'MINIMUM_VT2', CS%minVtsqr, & 'Min of the unresolved velocity Vt2 used in Rib CVMix calculation. \n'// & 'Scaling: MINIMUM_VT2 = const1*d*N*ws, with d=1m, N=1e-5/s, ws=1e-6 m/s.', & units='m2/s2',default=1e-10) ! smg: for removal below - call get_param(paramFile, mod, 'CORRECT_SURFACE_LAYER_AVERAGE', CS%correctSurfLayerAvg, & + call get_param(paramFile, mdl, 'CORRECT_SURFACE_LAYER_AVERAGE', CS%correctSurfLayerAvg, & 'If true, applies a correction step to the averaging of surface layer\n'// & 'properties. This option is obsolete.', default=.False.) - call get_param(paramFile, mod, 'FIRST_GUESS_SURFACE_LAYER_DEPTH', CS%surfLayerDepth, & + call get_param(paramFile, mdl, 'FIRST_GUESS_SURFACE_LAYER_DEPTH', CS%surfLayerDepth, & 'The first guess at the depth of the surface layer used for averaging\n'// & 'the surface layer properties. If =0, the top model level properties\n'// & 'will be used for the surface layer. If CORRECT_SURFACE_LAYER_AVERAGE=True, a\n'// & 'subsequent correction is applied. This parameter is obsolete', units='m', default=0.) ! smg: for removal above - call get_param(paramFile, mod, 'NLT_SHAPE', string, & + call get_param(paramFile, mdl, 'NLT_SHAPE', string, & 'MOM6 method to set nonlocal transport profile.\n'// & 'Over-rides the result from CVMix. Allowed values are: \n'// & '\t CVMIX - Uses the profiles from CVmix specified by MATCH_TECHNIQUE\n'//& @@ -252,7 +252,7 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) case default ; call MOM_error(FATAL,"KPP_init: "// & "Unrecognized NLT_SHAPE option"//trim(string)) end select - call get_param(paramFile, mod, 'MATCH_TECHNIQUE', CS%MatchTechnique, & + call get_param(paramFile, mdl, 'MATCH_TECHNIQUE', CS%MatchTechnique, & 'CVMix method to set profile function for diffusivity and NLT,\n'// & 'as well as matching across OBL base. Allowed values are: \n'// & '\t SimpleShapes = sigma*(1-sigma)^2 for both diffusivity and NLT\n'// & @@ -265,14 +265,14 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) ! May be used during CVmix initialization. Cs_is_one=.true. endif - call get_param(paramFile, mod, 'KPP_ZERO_DIFFUSIVITY', CS%KPPzeroDiffusivity, & + call get_param(paramFile, mdl, 'KPP_ZERO_DIFFUSIVITY', CS%KPPzeroDiffusivity, & 'If True, zeroes the KPP diffusivity and viscosity; for testing purpose.',& default=.False.) - call get_param(paramFile, mod, 'KPP_IS_ADDITIVE', CS%KPPisAdditive, & + call get_param(paramFile, mdl, 'KPP_IS_ADDITIVE', CS%KPPisAdditive, & 'If true, adds KPP diffusivity to diffusivity from other schemes.'//& 'If false, KPP is the only diffusivity wherever KPP is non-zero.', & default=.True.) - call get_param(paramFile, mod, 'KPP_SHORTWAVE_METHOD',string, & + call get_param(paramFile, mdl, 'KPP_SHORTWAVE_METHOD',string, & 'Determines contribution of shortwave radiation to KPP surface '// & 'buoyancy flux. Options include:\n'// & ' ALL_SW: use total shortwave radiation\n'// & @@ -286,13 +286,13 @@ logical function KPP_init(paramFile, G, diag, Time, CS, passive) case default ; call MOM_error(FATAL,"KPP_init: "// & "Unrecognized KPP_SHORTWAVE_METHOD option"//trim(string)) end select - call get_param(paramFile, mod, 'CVMIX_ZERO_H_WORK_AROUND', CS%min_thickness, & + call get_param(paramFile, mdl, 'CVMIX_ZERO_H_WORK_AROUND', CS%min_thickness, & 'A minimum thickness used to avoid division by small numbers in the vicinity\n'// & 'of vanished layers. This is independent of MIN_THICKNESS used in other parts of MOM.', & units='m', default=0.) call closeParameterBlock(paramFile) - call get_param(paramFile, mod, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) call CVmix_init_kpp( Ri_crit=CS%Ri_crit, & minOBLdepth=CS%minOBLdepth, & diff --git a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 index fb0de2015c..3566e3cfaf 100644 --- a/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 +++ b/src/parameterizations/vertical/MOM_bulk_mixed_layer.F90 @@ -192,22 +192,81 @@ module MOM_bulk_mixed_layer contains +!> This subroutine partially steps the bulk mixed layer model. +!! The following processes are executed, in the order listed. +!! 1. Undergo convective adjustment into mixed layer. +!! 2. Apply surface heating and cooling. +!! 3. Starting from the top, entrain whatever fluid the TKE budget +!! permits. Penetrating shortwave radiation is also applied at +!! this point. +!! 4. If there is any unentrained fluid that was formerly in the +!! mixed layer, detrain this fluid into the buffer layer. This +!! is equivalent to the mixed layer detraining to the Monin- +!! Obukhov depth. +!! 5. Divide the fluid in the mixed layer evenly into CS%nkml pieces. +!! 6. Split the buffer layer if appropriate. +!! Layers 1 to nkml are the mixed layer, nkml+1 to nkml+nkbl are the +!! buffer layers. The results of this subroutine are mathematically +!! identical if there are multiple pieces of the mixed layer with +!! the same density or if there is just a single layer. There is no +!! stability limit on the time step. +!! +!! The key parameters for the mixed layer are found in the control structure. +!! These include mstar, nstar, nstar2, pen_SW_frac, pen_SW_scale, and TKE_decay. +!! For the Oberhuber (1993) mixed layer, the values of these are: +!! pen_SW_frac = 0.42, pen_SW_scale = 15.0 m, mstar = 1.25, +!! nstar = 1, TKE_decay = 2.5, conv_decay = 0.5 +!! TKE_decay is 1/kappa in eq. 28 of Oberhuber (1993), while conv_decay is 1/mu. +!! Conv_decay has been eliminated in favor of the well-calibrated form for the +!! efficiency of penetrating convection from Wang (2003). +!! For a traditional Kraus-Turner mixed layer, the values are: +!! pen_SW_frac = 0.0, pen_SW_scale = 0.0 m, mstar = 1.25, +!! nstar = 0.4, TKE_decay = 0.0, conv_decay = 0.0 subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & optics, Hml, aggregate_FW_forcing, dt_diag, last_call) - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: h_3d - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: u_3d, v_3d - type(thermo_var_ptrs), intent(inout) :: tv - type(forcing), intent(inout) :: fluxes - real, intent(in) :: dt - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(inout) :: ea, eb - type(bulkmixedlayer_CS), pointer :: CS - type(optics_type), pointer :: optics - real, dimension(:,:), pointer :: Hml !< active mixed layer depth - logical, intent(in) :: aggregate_FW_forcing - real, optional, intent(in) :: dt_diag - logical, optional, intent(in) :: last_call + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: h_3d !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: u_3d !< Zonal velocities interpolated to h points, + !! m s-1. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(in) :: v_3d !< Zonal velocities interpolated to h points, + !! m s-1. + type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any + !! available thermodynamic fields. Absent + !! fields have NULL ptrs. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + real, intent(in) :: dt !< Time increment, in s. + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: ea !< The amount of fluid moved downward into a + !! layer; this should be increased due to + !! mixed layer detrainment, in the same units + !! as h - usually m or kg m-2 (i.e., H). + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(inout) :: eb !< The amount of fluid moved upward into a + !! layer; this should be increased due to + !! mixed layer entrainment, in the same units + !! as h - usually m or kg m-2 (i.e., H). + type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a + !! previous call to mixedlayer_init. + type(optics_type), pointer :: optics !< The structure containing the inverse of the + !! vertical absorption decay scale for + !! penetrating shortwave radiation, in m-1. + real, dimension(:,:), pointer :: Hml !< active mixed layer depth + logical, intent(in) :: aggregate_FW_forcing + real, optional, intent(in) :: dt_diag !< The diagnostic time step, + !! which may be less than dt if there are + !! two callse to mixedlayer, in s. + logical, optional, intent(in) :: last_call !< if true, this is the last call + !! to mixedlayer in the current time step, so + !! diagnostics will be written. The default is + !! .true. ! This subroutine partially steps the bulk mixed layer model. ! The following processes are executed, in the order listed. @@ -850,17 +909,43 @@ subroutine bulkmixedlayer(h_3d, u_3d, v_3d, tv, fluxes, dt, ea, eb, G, GV, CS, & end subroutine bulkmixedlayer +!> This subroutine does instantaneous convective entrainment into the buffer +!! layers and mixed layers to remove hydrostatic instabilities. Any water that +!! is lighter than currently in the mixed- or buffer- layer is entrained. subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & dKE_CA, cTKE, j, G, GV, CS, nz_conv) - 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),SZK_(GV)), intent(inout) :: h, u, v - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T, S, R0, Rcv, d_eb + 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),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: u !< Zonal velocities interpolated to h + !! points, m s-1. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: v !< Zonal velocities interpolated to h + !! points, m s-1. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: T !< Layer temperatures, in deg C. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: S + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: R0 !< Potential density referenced to + !! surface pressure, in kg m-3. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: Rcv !< The coordinate defining potential + !! density, in kg m-3. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer + !! in the entrainment from below, in H. + !! Positive values go with mass gain by + !! a layer. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps - real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA, cTKE - integer, intent(in) :: j - type(bulkmixedlayer_CS), pointer :: CS - integer, optional, intent(in) :: nz_conv + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: dKE_CA !< The vertically integrated change in + !! kinetic energy due to convective + !! adjustment, in m3 s-2. + real, dimension(SZI_(G),SZK_(GV)), intent(out) :: cTKE !< The buoyant turbulent kinetic energy + !! source due to convective adjustment, + !! in m3 s-2. + integer, intent(in) :: j !< The j-index to work on. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + integer, optional, intent(in) :: nz_conv !< If present, the number of layers + !! over which to do convective adjustment + !! (perhaps CS%nkml). + ! This subroutine does instantaneous convective entrainment into the buffer ! layers and mixed layers to remove hydrostatic instabilities. Any water that ! is lighter than currently in the mixed- or buffer- layer is entrained. @@ -975,6 +1060,9 @@ subroutine convective_adjustment(h, u, v, R0, Rcv, T, S, eps, d_eb, & end subroutine convective_adjustment +!> This subroutine causes the mixed layer to entrain to the depth of free +!! convection. The depth of free convection is the shallowest depth at which the +!! fluid is denser than the average of the fluid above. subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, dR0_dS, dRcv_dS, & @@ -982,22 +1070,54 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & nsw, Pen_SW_bnd, opacity_band, Conv_en, & dKE_FC, j, ksort, G, GV, CS, tv, fluxes, dt, & aggregate_FW_forcing) - 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),SZK_(GV)), intent(inout) :: h, d_eb - real, dimension(SZI_(G)), intent(out) :: htot, Ttot, Stot - real, dimension(SZI_(G)), intent(out) :: uhtot, vhtot, R0_tot, Rcv_tot + 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),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a + !! layer in the entrainment from below + !! , in H. Positive values go with + !! mass gain by a layer. + real, dimension(SZI_(G)), intent(out) :: htot !< The accumulated mixed layer + !! thickness, in H. + real, dimension(SZI_(G)), intent(out) :: Ttot !< The depth integrated mixed layer + !! temperature, in deg C H. + real, dimension(SZI_(G)), intent(out) :: Stot !< The depth integrated mixed layer + !! salinity, in psu H. + real, dimension(SZI_(G)), intent(out) :: uhtot !< The depth integrated mixed layer + !! zonal velocity, H m s-1. + real, dimension(SZI_(G)), intent(out) :: vhtot !< The integrated mixed layer + !! meridional velocity, H m s-1. + real, dimension(SZI_(G)), intent(out) :: R0_tot !< The integrated mixed layer + !! potential density referenced to 0 + !! pressure, in kg m-2. + real, dimension(SZI_(G)), intent(out) :: Rcv_tot !< The integrated mixed layer + !! coordinate variable potential + !! density, in kg m-2. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: u, v, T, S, R0, Rcv, eps real, dimension(SZI_(G)), intent(in) :: dR0_dT, dRcv_dT, dR0_dS, dRcv_dS real, dimension(SZI_(G)), intent(in) :: netMassInOut, netMassOut real, dimension(SZI_(G)), intent(in) :: Net_heat, Net_salt - integer, intent(in) :: nsw - real, dimension(:,:), intent(inout) :: Pen_SW_bnd + integer, intent(in) :: nsw !< The number of bands of penetrating + !! shortwave radiation. + real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each + !! penetrating band, in K H, + !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band - real, dimension(SZI_(G)), intent(out) :: Conv_en, dKE_FC - integer, intent(in) :: j - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort - type(bulkmixedlayer_CS), pointer :: CS + real, dimension(SZI_(G)), intent(out) :: Conv_en !< The buoyant turbulent kinetic + !! energy source due to free + !! convection, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: dKE_FC !< The vertically integrated change + !! in kinetic energy due to free + !! convection, in m3 s-2. + integer, intent(in) :: j !< The j-index to work on. + integer, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: ksort !< The density-sorted k-indices. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this + !! module. type(thermo_var_ptrs), intent(inout) :: tv type(forcing), intent(inout) :: fluxes real, intent(in) :: dt @@ -1303,23 +1423,49 @@ subroutine mixedlayer_convection(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & end subroutine mixedlayer_convection +!> This subroutine determines the TKE available at the depth of free +!! convection to drive mechanical entrainment. subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, & TKE, TKE_river, Idecay_len_TKE, cMKE, dt, Idt_diag, & j, ksort, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G)), intent(in) :: htot, h_CA - type(forcing), intent(in) :: fluxes - real, dimension(SZI_(G)), intent(inout) :: Conv_En - real, dimension(SZI_(G)), intent(in) :: dKE_FC - real, dimension(SZI_(G),SZK_(GV)), intent(in) :: cTKE, dKE_CA - real, dimension(SZI_(G)), intent(out) :: TKE, Idecay_len_TKE - real, dimension(SZI_(G)), intent(in) :: TKE_river - real, dimension(2,SZI_(G)), intent(out) :: cMKE - real, intent(in) :: dt, Idt_diag - integer, intent(in) :: j - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort - type(bulkmixedlayer_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(SZI_(G)), intent(in) :: htot !< The accumlated mixed layer thickness, in m + !! or kg m-2. (Intent in). + real, dimension(SZI_(G)), intent(in) :: h_CA !< The mixed layer depth after convective + !! adjustment, in H. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + real, dimension(SZI_(G)), intent(inout) :: Conv_En !< The buoyant turbulent kinetic energy + !! source due to free convection, + !! in m3 s-2. + real, dimension(SZI_(G)), intent(in) :: dKE_FC !< The vertically integrated change in + !! kinetic energy due to free convection, + !! in m3 s-2. + real, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: cTKE !< The buoyant turbulent kinetic energy + !! source due to convective adjustment, + !! in m3 s-2. + real, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: dKE_CA !< The vertically integrated change in + !! kinetic energy due to convective + !! adjustment, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: TKE !< The turbulent kinetic energy available for + !! mixing over a time step, in m3 s-2. + real, dimension(SZI_(G)), intent(out) :: Idecay_len_TKE !< The inverse of the vertical decay + !! scale for TKE, in H-1. + real, dimension(SZI_(G)), intent(in) :: TKE_river + real, dimension(2,SZI_(G)), intent(out) :: cMKE !< Coefficients of HpE and HpE^2 in + !! calculating the denominator of MKE_rate, + !! in H-1 and H-2. + real, intent(in) :: dt !< The time step in s. + real, intent(in) :: Idt_diag + integer, intent(in) :: j !< The j-index to work on. + integer, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: ksort !< The density-sorted k-indicies. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this module. + ! This subroutine determines the TKE available at the depth of free ! convection to drive mechanical entrainment. @@ -1486,30 +1632,58 @@ subroutine find_starting_TKE(htot, h_CA, fluxes, Conv_En, cTKE, dKE_FC, dKE_CA, end subroutine find_starting_TKE - +!> This subroutine calculates mechanically driven entrainment. subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & R0_tot, Rcv_tot, u, v, T, S, R0, Rcv, eps, & dR0_dT, dRcv_dT, cMKE, Idt_diag, nsw, & Pen_SW_bnd, opacity_band, TKE, & Idecay_len_TKE, j, ksort, G, GV, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: h, d_eb - real, dimension(SZI_(G)), intent(inout) :: htot, Ttot, Stot - real, dimension(SZI_(G)), intent(inout) :: uhtot, vhtot - real, dimension(SZI_(G)), intent(inout) :: R0_tot, Rcv_tot + 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),SZK_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a + !! layer in the entrainment from + !! below, in H. Positive values go + !! with mass gain by a layer. + real, dimension(SZI_(G)), intent(inout) :: htot !< The accumlated mixed layer + !! thickness, in H. + real, dimension(SZI_(G)), intent(inout) :: Ttot !< The depth integrated mixed layer + !! temperature, in deg C H. + real, dimension(SZI_(G)), intent(inout) :: Stot !< The depth integrated mixed layer + !! salinity, in psu H. + real, dimension(SZI_(G)), intent(inout) :: uhtot !< The depth integrated mixed layer + !! zonal velocity, H m s-1. + real, dimension(SZI_(G)), intent(inout) :: vhtot !< The integrated mixed layer + !! meridional velocity, H m s-1. + real, dimension(SZI_(G)), intent(inout) :: R0_tot !< The integrated mixed layer + !! potential density referenced to 0 + !! pressure, in H kg m-3. + real, dimension(SZI_(G)), intent(inout) :: Rcv_tot !< The integrated mixed layer + !! coordinate variable potential + !! density, in H kg m-3. real, dimension(SZI_(G),SZK_(GV)), intent(in) :: u, v, T, S, R0, Rcv, eps real, dimension(SZI_(G)), intent(in) :: dR0_dT, dRcv_dT real, dimension(2,SZI_(G)), intent(in) :: cMKE real, intent(in) :: Idt_diag - integer, intent(in) :: nsw - real, dimension(:,:), intent(inout) :: Pen_SW_bnd + integer, intent(in) :: nsw !< The number of bands of penetrating + !! shortwave radiation. + real, dimension(:,:), intent(inout) :: Pen_SW_bnd !< The penetrating shortwave + !! heating at the sea surface in each + !! penetrating band, in K H, + !! size nsw x SZI_(G). real, dimension(:,:,:), intent(in) :: opacity_band - real, dimension(SZI_(G)), intent(inout) :: TKE + real, dimension(SZI_(G)), intent(inout) :: TKE !< The turbulent kinetic energy + !! available for mixing over a time + !! step, in m3 s-2. real, dimension(SZI_(G)), intent(inout) :: Idecay_len_TKE - integer, intent(in) :: j - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort - type(bulkmixedlayer_CS), pointer :: CS + integer, intent(in) :: j !< The j-index to work on. + integer, dimension(SZI_(G),SZK_(GV)), & + intent(in) :: ksort !< The density-sorted k-indicies. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this + !! module. ! This subroutine calculates mechanically driven entrainment. ! Arguments: h - Layer thickness, in m or kg m-2. (Intent in/out) The units @@ -1807,12 +1981,21 @@ subroutine mechanical_entrainment(h, d_eb, htot, Ttot, Stot, uhtot, vhtot, & end subroutine mechanical_entrainment +!> This subroutine generates an array of indices that are sorted by layer +!! density. subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) - 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),SZK_(GV)), intent(in) :: h, R0, eps - type(bulkmixedlayer_CS), pointer :: CS - integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort + 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),SZK_(GV)), intent(in) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: R0 !< The potential density used to sort + !! the layers, in kg m-3. + real, dimension(SZI_(G),SZK_(GV)), intent(in) :: eps !< The (small) thickness that must + !! remain in each layer, in H. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a + !! previous call to mixedlayer_init. + integer, dimension(SZI_(G),SZK_(GV)), intent(out) :: ksort !< The k-index to use in the sort. ! This subroutine generates an array of indices that are sorted by layer ! density. @@ -1864,17 +2047,57 @@ subroutine sort_ML(h, R0, eps, G, GV, CS, ksort) end subroutine sort_ML +!> This subroutine actually moves properties between layers to achieve a +!! resorted state, with all of the resorted water either moved into the correct +!! interior layers or in the top nkmb layers. subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS) - 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),SZK0_(GV)), intent(inout) :: h, T, S, R0, Rcv - real, dimension(SZK_(GV)), intent(in) :: RcvTgt - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps, d_ea, d_eb - integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort - type(bulkmixedlayer_CS), pointer :: CS - real, dimension(SZI_(G)), intent(in) :: dR0_dT, dR0_dS - real, dimension(SZI_(G)), intent(in) :: dRcv_dT, dRcv_dS + 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),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h + !! are referred to as H below. + !! Layer 0 is the new mixed layer. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Layer temperatures, in deg C. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Layer salinities, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to + !! surface pressure, in kg m-3. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining + !! potential density, in kg m-3. + real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each + !! layer, in kg m-3. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: eps !< The (small) thickness that must + !! remain in each layer, in H. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a + !! layer in the entrainment from + !! above, in m or kg m-2 (H). + !! Positive d_ea goes with layer + !! thickness increases. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a + !! layer in the entrainment from + !! below, in H. Positive values go + !! with mass gain by a layer. + integer, dimension(SZI_(G),SZK_(GV)), intent(in) :: ksort !< The density-sorted k-indicies. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure for this + !! module. + real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of + !! potential density referenced + !! to the surface with potential + !! temperature, in kg m-3 K-1. + real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of + !! cpotential density referenced + !! to the surface with salinity, + !! in kg m-3 psu-1. + real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of + !! coordinate defining potential + !! density with potential + !! temperature, in kg m-3 K-1. + real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of + !! coordinate defining potential + !! density with salinity, + !! in kg m-3 psu-1. + ! This subroutine actually moves properties between layers to achieve a ! resorted state, with all of the resorted water either moved into the correct ! interior layers or in the top nkmb layers. @@ -2177,18 +2400,53 @@ subroutine resort_ML(h, T, S, R0, Rcv, RcvTgt, eps, d_ea, d_eb, ksort, G, GV, CS end subroutine resort_ML +!> This subroutine moves any water left in the former mixed layers into the +!! two buffer layers and may also move buffer layer water into the interior +!! isopycnal layers. subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, G, GV, CS, & dR0_dT, dR0_dS, dRcv_dT, dRcv_dS, max_BL_det) - 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),SZK0_(GV)), intent(inout) :: h, T, S, R0, Rcv - real, dimension(SZK_(GV)), intent(in) :: RcvTgt - real, intent(in) :: dt, dt_diag - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea - integer, intent(in) :: j - type(bulkmixedlayer_CS), pointer :: CS - real, dimension(SZI_(G)), intent(in) :: dR0_dT, dR0_dS, dRcv_dT, dRcv_dS - real, dimension(SZI_(G)), intent(in) :: max_BL_det + 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),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. + !! Layer 0 is the new mixed layer. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to + !! surface pressure, in kg m-3. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential + !! density, in kg m-3. + real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each + !! layer, in kg m-3. + real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt_diag !< The diagnostic time step, in s. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in + !! the entrainment from above, in m or + !! kg m-2 (H). Positive d_ea goes with + !! layer thickness increases. + integer, intent(in) :: j !< The meridional row to work on. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a + !! previous call to mixedlayer_init. + real, dimension(SZI_(G)), intent(in) :: dR0_dT !< The partial derivative of + !! potential density referenced to the + !! surface with potential temperature, + !! in kg m-3 K-1. + real, dimension(SZI_(G)), intent(in) :: dR0_dS !< The partial derivative of + !! cpotential density referenced to the + !! surface with salinity, + !! in kg m-3 psu-1. + real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of + !! coordinate defining potential density + !! with potential temperature, + !! in kg m-3 K-1. + real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of + !! coordinate defining potential density + !! with salinity, in kg m-3 psu-1. + real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum + !! detrainment permitted from the buffer + !! layers, in H. + ! This subroutine moves any water left in the former mixed layers into the ! two buffer layers and may also move buffer layer water into the interior ! isopycnal layers. @@ -3066,17 +3324,49 @@ subroutine mixedlayer_detrain_2(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, j, end subroutine mixedlayer_detrain_2 +!> This subroutine moves any water left in the former mixed layers into the +!! single buffer layers and may also move buffer layer water into the interior +!! isopycnal layers. subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_eb, & j, G, GV, CS, dRcv_dT, dRcv_dS, max_BL_det) - 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),SZK0_(GV)), intent(inout) :: h, T, S, R0, Rcv - real, dimension(SZK_(GV)), intent(in) :: RcvTgt - real, intent(in) :: dt, dt_diag - real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea, d_eb - integer, intent(in) :: j - type(bulkmixedlayer_CS), pointer :: CS - real, dimension(SZI_(G)), intent(in) :: dRcv_dT, dRcv_dS, max_BL_det + 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),SZK0_(GV)), intent(inout) :: h !< Layer thickness, in m or kg m-2. + !! (Intent in/out) The units of h are + !! referred to as H below. Layer 0 is + !! the new mixed layer. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: T !< Potential temperature, in C. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: S !< Salinity, in psu. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: R0 !< Potential density referenced to + !! surface pressure, in kg m-3. + real, dimension(SZI_(G),SZK0_(GV)), intent(inout) :: Rcv !< The coordinate defining potential + !! density, in kg m-3. + real, dimension(SZK_(GV)), intent(in) :: RcvTgt !< The target value of Rcv for each + !! layer, in kg m-3. + real, intent(in) :: dt !< Time increment, in s. + real, intent(in) :: dt_diag + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_ea !< The upward increase across a layer in + !! the entrainment from above, in m or + !! kg m-2 (H). Positive d_ea goes with + !! layer thickness increases. + real, dimension(SZI_(G),SZK_(GV)), intent(inout) :: d_eb !< The downward increase across a layer + !! in the entrainment from below, in H. + !! Positive values go with mass gain by + !! a layer. + integer, intent(in) :: j !< The meridional row to work on. + type(bulkmixedlayer_CS), pointer :: CS !< The control structure returned by a + !! previous call to mixedlayer_init. + real, dimension(SZI_(G)), intent(in) :: dRcv_dT !< The partial derivative of + !! coordinate defining potential density + !! with potential temperature, + !! in kg m-3 K-1. + real, dimension(SZI_(G)), intent(in) :: dRcv_dS !< The partial derivative of + !! coordinate defining potential density + !! with salinity, in kg m-3 psu-1. + real, dimension(SZI_(G)), intent(in) :: max_BL_det !< If non-negative, the maximum + !! detrainment permitted from the buffer + !! layers, in H. + ! This subroutine moves any water left in the former mixed layers into the ! single buffer layers and may also move buffer layer water into the interior ! isopycnal layers. @@ -3352,13 +3642,17 @@ subroutine mixedlayer_detrain_1(h, T, S, R0, Rcv, RcvTgt, dt, dt_diag, d_ea, d_e end subroutine mixedlayer_detrain_1 +! #@# This subroutine needs a doxygen description. subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) type(time_type), target, intent(in) :: Time - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag - type(bulkmixedlayer_CS), pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic + !! output. + type(bulkmixedlayer_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. ! Arguments: Time - The current model time. ! (in) G - The ocean's grid structure. ! (in) GV - The ocean's vertical grid structure. @@ -3369,7 +3663,7 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_mixed_layer" ! This module's name. + character(len=40) :: mdl = "MOM_mixed_layer" ! This module's name. real :: omega_frac_dflt, ustar_min_dflt integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -3387,82 +3681,82 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) if (GV%nkml < 1) return ! Set default, read and log parameters - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") CS%nkml = GV%nkml - call log_param(param_file, mod, "NKML", CS%nkml, & + call log_param(param_file, mdl, "NKML", CS%nkml, & "The number of sublayers within the mixed layer if \n"//& "BULKMIXEDLAYER is true.", units="nondim", default=2) CS%nkbl = GV%nk_rho_varies - GV%nkml - call log_param(param_file, mod, "NKBL", CS%nkbl, & + call log_param(param_file, mdl, "NKBL", CS%nkbl, & "The number of variable density buffer layers if \n"//& "BULKMIXEDLAYER is true.", units="nondim", default=2) - call get_param(param_file, mod, "MSTAR", CS%mstar, & + call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE \n"//& "input to the mixed layer.", "units=nondim", default=1.2) - call get_param(param_file, mod, "NSTAR", CS%nstar, & + call get_param(param_file, mdl, "NSTAR", CS%nstar, & "The portion of the buoyant potential energy imparted by \n"//& "surface fluxes that is available to drive entrainment \n"//& "at the base of mixed layer when that energy is positive.", & units="nondim", default=0.15) - call get_param(param_file, mod, "BULK_RI_ML", CS%bulk_Ri_ML, & + call get_param(param_file, mdl, "BULK_RI_ML", CS%bulk_Ri_ML, & "The efficiency with which mean kinetic energy released \n"//& "by mechanically forced entrainment of the mixed layer \n"//& "is converted to turbulent kinetic energy.", units="nondim",& fail_if_missing=.true.) - call get_param(param_file, mod, "ABSORB_ALL_SW", CS%absorb_all_sw, & + call get_param(param_file, mdl, "ABSORB_ALL_SW", CS%absorb_all_sw, & "If true, all shortwave radiation is absorbed by the \n"//& "ocean, instead of passing through to the bottom mud.", & default=.false.) - call get_param(param_file, mod, "TKE_DECAY", CS%TKE_decay, & + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "TKE_DECAY relates the vertical rate of decay of the \n"//& "TKE available for mechanical entrainment to the natural \n"//& "Ekman depth.", units="nondim", default=2.5) - call get_param(param_file, mod, "NSTAR2", CS%nstar2, & + call get_param(param_file, mdl, "NSTAR2", CS%nstar2, & "The portion of any potential energy released by \n"//& "convective adjustment that is available to drive \n"//& "entrainment at the base of mixed layer. By default \n"//& "NSTAR2=NSTAR.", units="nondim", default=CS%nstar) - call get_param(param_file, mod, "BULK_RI_CONVECTIVE", CS%bulk_Ri_convective, & + call get_param(param_file, mdl, "BULK_RI_CONVECTIVE", CS%bulk_Ri_convective, & "The efficiency with which convectively released mean \n"//& "kinetic energy is converted to turbulent kinetic \n"//& "energy. By default BULK_RI_CONVECTIVE=BULK_RI_ML.", & units="nondim", default=CS%bulk_Ri_ML) - call get_param(param_file, mod, "HMIX_MIN", CS%Hmix_min, & + call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mod, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & + call get_param(param_file, mdl, "LIMIT_BUFFER_DETRAIN", CS%limit_det, & "If true, limit the detrainment from the buffer layers \n"//& "to not be too different from the neighbors.", default=.false.) - call get_param(param_file, mod, "ALLOWED_DETRAIN_TEMP_CHG", CS%Allowed_T_chg, & + call get_param(param_file, mdl, "ALLOWED_DETRAIN_TEMP_CHG", CS%Allowed_T_chg, & "The amount by which temperature is allowed to exceed \n"//& "previous values during detrainment.", units="K", default=0.5) - call get_param(param_file, mod, "ALLOWED_DETRAIN_SALT_CHG", CS%Allowed_S_chg, & + call get_param(param_file, mdl, "ALLOWED_DETRAIN_SALT_CHG", CS%Allowed_S_chg, & "The amount by which salinity is allowed to exceed \n"//& "previous values during detrainment.", units="PSU", default=0.1) - call get_param(param_file, mod, "ML_DT_DS_WEIGHT", CS%dT_dS_wt, & + call get_param(param_file, mdl, "ML_DT_DS_WEIGHT", CS%dT_dS_wt, & "When forced to extrapolate T & S to match the layer \n"//& "densities, this factor (in deg C / PSU) is combined \n"//& "with the derivatives of density with T & S to determine \n"//& "what direction is orthogonal to density contours. It \n"//& "should be a typical value of (dR/dS) / (dR/dT) in \n"//& "oceanic profiles.", units="degC PSU-1", default=6.0) - call get_param(param_file, mod, "BUFFER_LAYER_EXTRAP_LIMIT", CS%BL_extrap_lim, & + call get_param(param_file, mdl, "BUFFER_LAYER_EXTRAP_LIMIT", CS%BL_extrap_lim, & "A limit on the density range over which extrapolation \n"//& "can occur when detraining from the buffer layers, \n"//& "relative to the density range within the mixed and \n"//& "buffer layers, when the detrainment is going into the \n"//& "lightest interior layer, nondimensional, or a negative \n"//& "value not to apply this limit.", units="nondim", default = -1.0) - call get_param(param_file, mod, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & + call get_param(param_file, mdl, "DEPTH_LIMIT_FLUXES", CS%H_limit_fluxes, & "The surface fluxes are scaled away when the total ocean \n"//& "depth is less than DEPTH_LIMIT_FLUXES.", & units="m", default=0.1*CS%Hmix_min) - call get_param(param_file, mod, "OMEGA",CS%omega, & + call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) - call get_param(param_file, mod, "ML_USE_OMEGA", use_omega, & + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the \n"//& "vertical component of rotation when setting the decay \n"//& "scale for turbulence.", default=.false., do_not_log=.true.) @@ -3471,57 +3765,57 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mod, "ML_OMEGA_FRAC", CS%omega_frac, & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & "When setting the decay scale for turbulence, use this \n"//& "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mod, "ML_RESORT", CS%ML_resort, & + call get_param(param_file, mdl, "ML_RESORT", CS%ML_resort, & "If true, resort the topmost layers by potential density \n"//& "before the mixed layer calculations.", default=.false.) if (CS%ML_resort) & - call get_param(param_file, mod, "ML_PRESORT_NK_CONV_ADJ", CS%ML_presort_nz_conv_adj, & + call get_param(param_file, mdl, "ML_PRESORT_NK_CONV_ADJ", CS%ML_presort_nz_conv_adj, & "Convectively mix the first ML_PRESORT_NK_CONV_ADJ \n"//& "layers before sorting when ML_RESORT is true.", & units="nondim", default=0, fail_if_missing=.true.) ! Fail added by AJA. ! This gives a minimum decay scale that is typically much less than Angstrom. ustar_min_dflt = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) - call get_param(param_file, mod, "BML_USTAR_MIN", CS%ustar_min, & + call get_param(param_file, mdl, "BML_USTAR_MIN", CS%ustar_min, & "The minimum value of ustar that should be used by the \n"//& "bulk mixed layer model in setting vertical TKE decay \n"//& "scales. This must be greater than 0.", units="m s-1", & default=ustar_min_dflt) if (CS%ustar_min<=0.0) call MOM_error(FATAL, "BML_USTAR_MIN must be positive.") - call get_param(param_file, mod, "RESOLVE_EKMAN", CS%Resolve_Ekman, & + call get_param(param_file, mdl, "RESOLVE_EKMAN", CS%Resolve_Ekman, & "If true, the NKML>1 layers in the mixed layer are \n"//& "chosen to optimally represent the impact of the Ekman \n"//& "transport on the mixed layer TKE budget. Otherwise, \n"//& "the sublayers are distributed uniformly through the \n"//& "mixed layer.", default=.false.) - call get_param(param_file, mod, "CORRECT_ABSORPTION_DEPTH", CS%correct_absorption, & + call get_param(param_file, mdl, "CORRECT_ABSORPTION_DEPTH", CS%correct_absorption, & "If true, the average depth at which penetrating shortwave \n"//& "radiation is absorbed is adjusted to match the average \n"//& "heating depth of an exponential profile by moving some \n"//& "of the heating upward in the water column.", default=.false.) - call get_param(param_file, mod, "DO_RIVERMIX", CS%do_rivermix, & + call get_param(param_file, mdl, "DO_RIVERMIX", CS%do_rivermix, & "If true, apply additional mixing whereever there is \n"//& "runoff, so that it is mixed down to RIVERMIX_DEPTH, \n"//& "if the ocean is that deep.", default=.false.) if (CS%do_rivermix) & - call get_param(param_file, mod, "RIVERMIX_DEPTH", CS%rivermix_depth, & + call get_param(param_file, mdl, "RIVERMIX_DEPTH", CS%rivermix_depth, & "The depth to which rivers are mixed if DO_RIVERMIX is \n"//& "defined.", units="m", default=0.0) - call get_param(param_file, mod, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & + call get_param(param_file, mdl, "USE_RIVER_HEAT_CONTENT", CS%use_river_heat_content, & "If true, use the fluxes%runoff_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*liq_runoff.", & default=.false.) - call get_param(param_file, mod, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & + call get_param(param_file, mdl, "USE_CALVING_HEAT_CONTENT", CS%use_calving_heat_content, & "If true, use the fluxes%calving_Hflx field to set the \n"//& "heat carried by runoff, instead of using SST*CP*froz_runoff.", & default=.false.) - call get_param(param_file, mod, "ALLOW_CLOCKS_IN_OMP_LOOPS", & + call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", & CS%allow_clocks_in_omp_loops, & "If true, clocks can be called from inside loops that can \n"//& "be threaded. To run with multiple threads, set to False.", & @@ -3559,22 +3853,22 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) Time, 'Minimum surface region thickness', 'meter') !CS%lim_det_dH_sfc = 0.5 ; CS%lim_det_dH_bathy = 0.2 ! Technically these should not get used if limit_det is false? if (CS%limit_det .or. (CS%id_Hsfc_min > 0)) then - call get_param(param_file, mod, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & + call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_SFC", CS%lim_det_dH_sfc, & "The fractional limit in the change between grid points \n"//& "of the surface region (mixed & buffer layer) thickness.", & units="nondim", default=0.5) - call get_param(param_file, mod, "LIMIT_BUFFER_DET_DH_BATHY", CS%lim_det_dH_bathy, & + call get_param(param_file, mdl, "LIMIT_BUFFER_DET_DH_BATHY", CS%lim_det_dH_bathy, & "The fraction of the total depth by which the thickness \n"//& "of the surface region (mixed & buffer layer) is allowed \n"//& "to change between grid points.", units="nondim", default=0.2) endif - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state \n"//& "variables.", default=.true.) CS%nsw = 0 if (use_temperature) then - call get_param(param_file, mod, "PEN_SW_NBANDS", CS%nsw, default=1) + call get_param(param_file, mdl, "PEN_SW_NBANDS", CS%nsw, default=1) endif @@ -3617,9 +3911,17 @@ subroutine bulkmixedlayer_init(Time, G, GV, param_file, diag, CS) end subroutine bulkmixedlayer_init +!> This subroutine returns an approximation to the integral +!! R = exp(-L*(H+E)) integral(LH to L(H+E)) L/(1-(1+x)exp(-x)) dx. +!! The approximation to the integrand is good to within -2% at x~.3 +!! and +25% at x~3.5, but the exponential deemphasizes the importance of +!! large x. When L=0, EF4 returns E/((H+E)*H). function EF4(H, E, L, dR_de) -real, intent(in) :: H, E, L -real, intent(inout), optional :: dR_de +real, intent(in) :: H !< Total thickness, in m or kg m-2. (Intent in) The units of h + !! are referred to as H below. +real, intent(in) :: E !< Entrainment, in units of H. +real, intent(in) :: L !< The e-folding scale in H-1. +real, intent(inout), optional :: dR_de !< The partial derivative of the result R with E, in H-2. real :: EF4 ! This subroutine returns an approximation to the integral ! R = exp(-L*(H+E)) integral(LH to L(H+E)) L/(1-(1+x)exp(-x)) dx. diff --git a/src/parameterizations/vertical/MOM_cvmix_shear.F90 b/src/parameterizations/vertical/MOM_cvmix_shear.F90 index 12d4eeefa3..460dde7c47 100644 --- a/src/parameterizations/vertical/MOM_cvmix_shear.F90 +++ b/src/parameterizations/vertical/MOM_cvmix_shear.F90 @@ -38,7 +38,7 @@ module MOM_cvmix_shear character(10) :: Mix_Scheme !< Mixing scheme name (string) end type CVMix_shear_CS -character(len=40) :: mod = "MOM_CVMix_shear" !< This module's name. +character(len=40) :: mdl = "MOM_CVMix_shear" !< This module's name. contains @@ -148,16 +148,16 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) allocate(CS) ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "Parameterization of shear-driven turbulence via CVMix (various options)") - call get_param(param_file, mod, "USE_LMD94", CS%use_LMD94, & + call get_param(param_file, mdl, "USE_LMD94", CS%use_LMD94, & "If true, use the Large-McWilliams-Doney (JGR 1994) \n"//& "shear mixing parameterization.", default=.false.) if (CS%use_LMD94) then NumberTrue=NumberTrue + 1 CS%Mix_Scheme='KPP' endif - call get_param(param_file, mod, "USE_PP81", CS%use_PP81, & + call get_param(param_file, mdl, "USE_PP81", CS%use_PP81, & "If true, use the Pacanowski and Philander (JPO 1981) \n"//& "shear mixing parameterization.", default=.false.) if (CS%use_PP81) then @@ -177,15 +177,15 @@ logical function cvmix_shear_init(Time, G, GV, param_file, diag, CS) ! Forego remainder of initialization if not using this scheme if (.not. cvmix_shear_init) return - call get_param(param_file, mod, "NU_ZERO", CS%Nu_Zero, & + call get_param(param_file, mdl, "NU_ZERO", CS%Nu_Zero, & "Leading coefficient in KPP shear mixing.", & units="nondim", default=5.e-3) - call get_param(param_file, mod, "RI_ZERO", CS%Ri_Zero, & + call get_param(param_file, mdl, "RI_ZERO", CS%Ri_Zero, & "Critical Richardson for KPP shear mixing,"// & " NOTE this the internal mixing and this is"// & " not for setting the boundary layer depth." & ,units="nondim", default=0.7) - call get_param(param_file, mod, "KPP_EXP", CS%KPP_exp, & + call get_param(param_file, mdl, "KPP_EXP", CS%KPP_exp, & "Exponent of unitless factor of diffusivities,"// & " for KPP internal shear mixing scheme." & ,units="nondim", default=3.0) @@ -206,9 +206,9 @@ logical function cvmix_shear_is_used(param_file) type(param_file_type), intent(in) :: param_file !< Run-time parameter files handle. ! Local variables logical :: LMD94, PP81 - call get_param(param_file, mod, "USE_LMD94", LMD94, & + call get_param(param_file, mdl, "USE_LMD94", LMD94, & default=.false., do_not_log = .true.) - call get_param(param_file, mod, "Use_PP81", PP81, & + call get_param(param_file, mdl, "Use_PP81", PP81, & default=.false., do_not_log = .true.) cvmix_shear_is_used = (LMD94 .or. PP81) end function cvmix_shear_is_used diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 263312d30f..bd04a0ed91 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -751,7 +751,7 @@ subroutine diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, G, GV, CS) CS%minimum_forcing_depth, cTKE, dSV_dT, dSV_dS) call calculateBuoyancyFlux2d(G, GV, fluxes, CS%optics, h, tv%T, tv%S, tv, & - CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux) + CS%KPP_buoy_flux, CS%KPP_temp_flux, CS%KPP_salt_flux, skip_diags=.true.) if (CS%debug) then call hchksum(ea, "after applyBoundaryFluxes ea",G%HI,haloshift=0, scale=GV%H_to_m) @@ -2073,13 +2073,15 @@ subroutine diabatic_driver_init(Time, G, GV, param_file, useALEalgorithm, diag, ! CS%useKPP is set to True if KPP-scheme is to be used, False otherwise. ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive CS%useKPP = KPP_init(param_file, G, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) - if (CS%useKPP .or. CS%use_energetic_PBL) then + if (CS%useKPP) then allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. + endif + if (CS%useKPP .or. CS%use_energetic_PBL) then allocate( CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_buoy_flux(:,:,:) = 0. allocate( CS%KPP_temp_flux(isd:ied,jsd:jed) ) ; CS%KPP_temp_flux(:,:) = 0. allocate( CS%KPP_salt_flux(isd:ied,jsd:jed) ) ; CS%KPP_salt_flux(:,:) = 0. - endif + endif call get_param(param_file, mod, "SALT_REJECT_BELOW_ML", CS%salt_reject_below_ML, & "If true, place salt from brine rejection below the mixed layer,\n"// & @@ -2319,11 +2321,13 @@ subroutine diabatic_driver_end(CS) call entrain_diffusive_end(CS%entrain_diffusive_CSp) call set_diffusivity_end(CS%set_diff_CSp) if (CS%useKPP .or. CS%use_energetic_PBL) then - deallocate( CS%KPP_NLTheat ) - deallocate( CS%KPP_NLTscalar ) deallocate( CS%KPP_buoy_flux ) deallocate( CS%KPP_temp_flux ) deallocate( CS%KPP_salt_flux ) + endif + if (CS%useKPP) then + deallocate( CS%KPP_NLTheat ) + deallocate( CS%KPP_NLTscalar ) call KPP_end(CS%KPP_CSp) endif if (CS%useConvection) call diffConvection_end(CS%Conv_CSp) diff --git a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 index b70b606c9f..7a79d8b4ac 100644 --- a/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 +++ b/src/parameterizations/vertical/MOM_diapyc_energy_req.F90 @@ -57,16 +57,21 @@ module MOM_diapyc_energy_req contains +! #@# This subroutine needs a doxygen description subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) - 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(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(G%isd:G%ied,G%jsd:G%jed,GV%ke), & - intent(in) :: h_3d - type(thermo_var_ptrs), intent(inout) :: tv - real, intent(in) :: dt - type(diapyc_energy_req_CS), pointer :: CS + intent(in) :: h_3d !< Layer thickness before entrainment, + !! in m or kg m-2. + type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any + !! available thermodynamic fields. + !! Absent fields have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this call, + !! in s. + type(diapyc_energy_req_CS), pointer :: CS !< This module's control structure. real, dimension(G%isd:G%ied,G%jsd:G%jed,GV%ke+1), & - optional, intent(in) :: Kd_int + optional, intent(in) :: Kd_int !< Interface diffusivities. ! Arguments: h_3d - Layer thickness before entrainment, in m or kg m-2. ! (in) tv - A structure containing pointers to any available @@ -127,17 +132,34 @@ subroutine diapyc_energy_req_test(h_3d, dt, tv, G, GV, CS, Kd_int) end subroutine diapyc_energy_req_test +!> This subroutine uses a substantially refactored tridiagonal equation for +!! diapycnal mixing of temperature and salinity to estimate the potential energy +!! change due to diapycnal mixing in a column of water. It does this estimate +!! 4 different ways, all of which should be equivalent, but reports only one. +!! The various estimates are taken because they will later be used as templates +!! for other bits of code subroutine diapyc_energy_req_calc(h_in, T_in, S_in, Kd, energy_Kd, dt, tv, & G, GV, may_print, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(GV%ke), intent(in) :: h_in, T_in, S_in - real, dimension(GV%ke+1), intent(in) :: Kd - real, intent(in) :: dt - real, intent(out) :: energy_Kd - type(thermo_var_ptrs), intent(inout) :: tv - logical, optional, intent(in) :: may_print - type(diapyc_energy_req_CS), optional, pointer :: CS + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + real, dimension(GV%ke), intent(in) :: h_in !< Layer thickness before entrainment, + !! in m or kg m-2. + real, dimension(GV%ke), intent(in) :: T_in !< The layer temperatures, in degC. + real, dimension(GV%ke), intent(in) :: S_in !< The layer salinities, in g kg-1. + real, dimension(GV%ke+1), intent(in) :: Kd !< The interfaces diapycnal diffusivities, + !! in m2 s-1. + real, intent(in) :: dt !< The amount of time covered by this call, + !! in s. + real, intent(out) :: energy_Kd !< The column-integrated rate of energy + !! consumption by diapycnal diffusion, in W m-2. + type(thermo_var_ptrs), intent(inout) :: tv !< A structure containing pointers to any + !! available thermodynamic fields. + !! Absent fields have NULL ptrs. + logical, optional, intent(in) :: may_print !< If present and true, write out diagnostics + !! of energy use. + type(diapyc_energy_req_CS), & + optional, pointer :: CS !< This module's control structure. + ! Arguments: h_in - Layer thickness before entrainment, in m or kg m-2. ! (in) T_in - The layer temperatures, in degC. ! (in) S_in - The layer salinities, in g kg-1. @@ -1283,7 +1305,7 @@ subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS) integer, save :: init_calls = 0 ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_diapyc_energy_req" ! This module's name. + character(len=40) :: mdl = "MOM_diapyc_energy_req" ! This module's name. character(len=256) :: mesg ! Message for error messages. if (.not.associated(CS)) then ; allocate(CS) @@ -1293,14 +1315,14 @@ subroutine diapyc_energy_req_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENERGY_REQ_KH_SCALING", CS%test_Kh_scaling, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENERGY_REQ_KH_SCALING", CS%test_Kh_scaling, & "A scaling factor for the diapycnal diffusivity used in \n"//& "testing the energy requirements.", default=1.0, units="nondim") - call get_param(param_file, mod, "ENERGY_REQ_COL_HT_SCALING", CS%ColHt_scaling, & + call get_param(param_file, mdl, "ENERGY_REQ_COL_HT_SCALING", CS%ColHt_scaling, & "A scaling factor for the column height change correction \n"//& "used in testing the energy requirements.", default=1.0, units="nondim") - call get_param(param_file, mod, "ENERGY_REQ_USE_TEST_PROFILE", & + call get_param(param_file, mdl, "ENERGY_REQ_USE_TEST_PROFILE", & CS%use_test_Kh_profile, & "If true, use the internal test diffusivity profile in \n"//& "place of any that might be passed in as an argument.", default=.false.) diff --git a/src/parameterizations/vertical/MOM_diffConvection.F90 b/src/parameterizations/vertical/MOM_diffConvection.F90 index c5e4097a36..294fc69c9a 100644 --- a/src/parameterizations/vertical/MOM_diffConvection.F90 +++ b/src/parameterizations/vertical/MOM_diffConvection.F90 @@ -50,17 +50,17 @@ logical function diffConvection_init(paramFile, G, diag, Time, CS) type(diffConvection_CS), pointer :: CS ! Control structure ! Local variables #include "version_variable.h" - character(len=40) :: mod = 'MOM_diffConvection' ! This module's name. + character(len=40) :: mdl = 'MOM_diffConvection' ! This module's name. if (associated(CS)) call MOM_error(FATAL, 'MOM_diffConvection, diffConvection_init: '// & 'Control structure has already been initialized') allocate(CS) ! Read parameters - call log_version(paramFile, mod, version, & + call log_version(paramFile, mdl, version, & 'This module implements enhanced diffusivity as a\n' // & 'function of static stability, N^2.') - call get_param(paramFile, mod, "USE_CONVECTION", diffConvection_init, & + call get_param(paramFile, mdl, "USE_CONVECTION", diffConvection_init, & "If true, turns on the diffusive convection scheme that\n"// & "increases diapycnal diffusivities at statically unstable\n"// & "interfaces. Relevant parameters are contained in the\n"// & @@ -68,14 +68,14 @@ logical function diffConvection_init(paramFile, G, diag, Time, CS) default=.false.) call openParameterBlock(paramFile,'CONVECTION') - call get_param(paramFile, mod, 'PASSIVE', CS%passiveMode, & + call get_param(paramFile, mdl, 'PASSIVE', CS%passiveMode, & 'If True, puts KPP into a passive-diagnostic mode.', & default=.False.) - call get_param(paramFile, mod, 'KD_CONV', CS%Kd_convection, & + call get_param(paramFile, mdl, 'KD_CONV', CS%Kd_convection, & 'DIffusivity used in statically unstable regions of column.', & units='m2/s', default=1.00) call closeParameterBlock(paramFile) - call get_param(paramFile, mod, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) + call get_param(paramFile, mdl, 'DEBUG', CS%debug, default=.False., do_not_log=.True.) ! Forego remainder of initialization if not using this scheme if (.not. diffConvection_init) return diff --git a/src/parameterizations/vertical/MOM_energetic_PBL.F90 b/src/parameterizations/vertical/MOM_energetic_PBL.F90 index 7c7439dd40..17ca253ae4 100644 --- a/src/parameterizations/vertical/MOM_energetic_PBL.F90 +++ b/src/parameterizations/vertical/MOM_energetic_PBL.F90 @@ -2034,7 +2034,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_energetic_PBL" ! This module's name. + character(len=40) :: mdl = "MOM_energetic_PBL" ! This module's name. real :: omega_frac_dflt integer :: isd, ied, jsd, jed logical :: use_temperature, use_omega @@ -2050,75 +2050,75 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) CS%Time => Time ! Set default, read and log parameters - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "MSTAR_MODE", CS%mstar_mode, & + call get_param(param_file, mdl, "MSTAR_MODE", CS%mstar_mode, & "An integer switch for how to compute MSTAR. \n"//& " 0 for constant MSTAR\n"//& " 1 for MSTAR w/ MLD in stabilizing limit\n"//& " 2 for MSTAR w/ L_E/L_O in stabilizing limit.",& "units=nondim",default=0) - call get_param(param_file, mod, "MSTAR", CS%mstar, & + call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE \n"//& "input to the mixed layer.", "units=nondim", default=1.2) - call get_param(param_file, mod, "MIX_LEN_EXPONENT", CS%MixLenExponent, & + call get_param(param_file, mdl, "MIX_LEN_EXPONENT", CS%MixLenExponent, & "The exponent applied to the ratio of the distance to the MLD \n"//& "and the MLD depth which determines the shape of the mixing length.",& "units=nondim", default=2.0) - call get_param(param_file, mod, "MSTAR_CAP", CS%mstar_cap, & + call get_param(param_file, mdl, "MSTAR_CAP", CS%mstar_cap, & "Maximum value of mstar allowed in model if non-negative\n"//& "(used if MSTAR_MODE>0).",& "units=nondim", default=-1.0) - call get_param(param_file, mod, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & + call get_param(param_file, mdl, "MSTAR_CONV_ADJ", CS%cnv_mst_fac, & "Factor used for reducing mstar during convection \n"//& " due to reduction of stable density gradient.",& "units=nondim", default=0.0) - call get_param(param_file, mod, "MSTAR_SLOPE", CS%mstar_slope, & + call get_param(param_file, mdl, "MSTAR_SLOPE", CS%mstar_slope, & "The slope of the linear relationship between mstar \n"//& "and the length scale ratio (used if MSTAR_MODE=1).",& "units=nondim", default=0.85) - call get_param(param_file, mod, "MSTAR_XINT", CS%mstar_xint, & + call get_param(param_file, mdl, "MSTAR_XINT", CS%mstar_xint, & "The value of the length scale ratio where the mstar \n"//& "is linear above (used if MSTAR_MODE=1).",& "units=nondim", default=-0.3) - call get_param(param_file, mod, "MSTAR_AT_XINT", CS%mstar_at_xint, & + call get_param(param_file, mdl, "MSTAR_AT_XINT", CS%mstar_at_xint, & "The value of mstar at MSTAR_XINT \n"//& "(used if MSTAR_MODE=1).",& "units=nondim", default=0.095) - call get_param(param_file, mod, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & + call get_param(param_file, mdl, "MSTAR_FLATCAP", CS%MSTAR_FLATCAP, & "Set false to use asymptotic cap, defaults to true.\n"//& "(used only if MSTAR_MODE=1)"& ,"units=nondim",default=.true.) - call get_param(param_file, mod, "MSTAR2_COEF1", CS%MSTAR_COEF, & + call get_param(param_file, mdl, "MSTAR2_COEF1", CS%MSTAR_COEF, & "Coefficient in computing mstar when rotation and \n"//& " stabilizing effects are both important (used if MSTAR_MODE=2)"& ,"units=nondim",default=0.3) - call get_param(param_file, mod, "MSTAR2_COEF2", CS%C_EK, & + call get_param(param_file, mdl, "MSTAR2_COEF2", CS%C_EK, & "Coefficient in computing mstar when only rotation limits \n"//& " the total mixing. (used only if MSTAR_MODE=2)"& ,"units=nondim",default=0.085) - call get_param(param_file, mod, "NSTAR", CS%nstar, & + call get_param(param_file, mdl, "NSTAR", CS%nstar, & "The portion of the buoyant potential energy imparted by \n"//& "surface fluxes that is available to drive entrainment \n"//& "at the base of mixed layer when that energy is positive.", & units="nondim", default=0.2) - call get_param(param_file, mod, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & + call get_param(param_file, mdl, "MKE_TO_TKE_EFFIC", CS%MKE_to_TKE_effic, & "The efficiency with which mean kinetic energy released \n"//& "by mechanically forced entrainment of the mixed layer \n"//& "is converted to turbulent kinetic energy.", units="nondim", & default=0.0) - call get_param(param_file, mod, "TKE_DECAY", CS%TKE_decay, & + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "TKE_DECAY relates the vertical rate of decay of the \n"//& "TKE available for mechanical entrainment to the natural \n"//& "Ekman depth.", units="nondim", default=2.5) -! call get_param(param_file, mod, "HMIX_MIN", CS%Hmix_min, & +! call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & ! "The minimum mixed layer depth if the mixed layer depth \n"//& ! "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mod, "OMEGA",CS%omega, & + call get_param(param_file, mdl, "OMEGA",CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) - call get_param(param_file, mod, "ML_USE_OMEGA", use_omega, & + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the \n"//& "vertical component of rotation when setting the decay \n"// & "scale for turbulence.", default=.false., do_not_log=.true.) @@ -2127,50 +2127,50 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mod, "ML_OMEGA_FRAC", CS%omega_frac, & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & "When setting the decay scale for turbulence, use this \n"// & "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mod, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & + call get_param(param_file, mdl, "WSTAR_USTAR_COEF", CS%wstar_ustar_coef, & "A ratio relating the efficiency with which convectively \n"//& "released energy is converted to a turbulent velocity, \n"// & "relative to mechanically forced TKE. Making this larger \n"//& "increases the BL diffusivity", units="nondim", default=1.0) - call get_param(param_file, mod, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & + call get_param(param_file, mdl, "VSTAR_SCALE_FACTOR", CS%vstar_scale_fac, & "An overall nondimensional scaling factor for v*. \n"// & "Making this larger decreases the PBL diffusivity.", & units="nondim", default=1.0) - call get_param(param_file, mod, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & + call get_param(param_file, mdl, "EKMAN_SCALE_COEF", CS%Ekman_scale_coef, & "A nondimensional scaling factor controlling the inhibition \n"// & "of the diffusive length scale by rotation. Making this larger \n"//& "decreases the PBL diffusivity.", units="nondim", default=1.0) - call get_param(param_file, mod, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & + call get_param(param_file, mdl, "USE_MLD_ITERATION", CS%USE_MLD_ITERATION, & "A logical that specifies whether or not to use the \n"// & "distance to the bottom of the actively turblent boundary \n"//& "layer to help set the EPBL length scale.", default=.false.) - call get_param(param_file, mod, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & + call get_param(param_file, mdl, "ORIG_MLD_ITERATION", CS%ORIG_MLD_ITERATION, & "A logical that specifies whether or not to use the \n"// & "old method for determining MLD depth in iteration, which \n"//& "is limited to resolution.", default=.true.) - call get_param(param_file, mod, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & + call get_param(param_file, mdl, "MLD_ITERATION_GUESS", CS%MLD_ITERATION_GUESS, & "A logical that specifies whether or not to use the \n"// & "previous timestep MLD as a first guess in the MLD iteration.\n"// & "The default is false to facilitate reproducibility.", default=.false.) - call get_param(param_file, mod, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & + call get_param(param_file, mdl, "EPBL_MLD_TOLERANCE", CS%MLD_tol, & "The tolerance for the iteratively determined mixed \n"// & "layer depth. This is only used with USE_MLD_ITERATION.", & units="meter", default=1.0) - call get_param(param_file, mod, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & + call get_param(param_file, mdl, "EPBL_MIN_MIX_LEN", CS%min_mix_len, & "The minimum mixing length scale that will be used \n"//& "by ePBL. The default (0) does not set a minimum.", & units="meter", default=0.0) - call get_param(param_file, mod, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & + call get_param(param_file, mdl, "EPBL_ORIGINAL_PE_CALC", CS%orig_PE_calc, & "If true, the ePBL code uses the original form of the \n"// & "potential energy change code. Otherwise, the newer \n"// & "version that can work with successive increments to the \n"// & "diffusivity in upward or downward passes is used.", default=.true.) - call get_param(param_file, mod, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & + call get_param(param_file, mdl, "EPBL_TRANSITION_SCALE", CS%transLay_scale, & "A scale for the mixing length in the transition layer \n"// & "at the edge of the boundary layer as a fraction of the \n"//& "boundary layer thickness. The default is 0.1.", & @@ -2179,25 +2179,25 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) call MOM_error(FATAL, "If flag USE_MLD_ITERATION is true, then "// & "EPBL_TRANSITION should be greater than 0 and less than 1.") endif - call get_param(param_file, mod, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & + call get_param(param_file, mdl, "N2_DISSIPATION_POS", CS%N2_Dissipation_Scale_Pos, & "A scale for the dissipation of TKE due to stratification \n"// & "in the boundary layer, applied when local stratification \n"// & "is positive. The default is 0, but should probably be ~0.4.", & units="nondim", default=0.0) - call get_param(param_file, mod, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& + call get_param(param_file, mdl, "N2_DISSIPATION_NEG", CS%N2_Dissipation_Scale_Neg,& "A scale for the dissipation of TKE due to stratification \n"// & "in the boundary layer, applied when local stratification \n"// & "is negative. The default is 0, but should probably be ~1.", & units="nondim", default=0.0) - call get_param(param_file, mod, "USE_LA_LI2016", CS%USE_LA_Windsea, & + call get_param(param_file, mdl, "USE_LA_LI2016", CS%USE_LA_Windsea, & "A logical to use the Li et al. 2016 (submitted) formula to \n"//& " determine the Langmuir number.", & units="nondim", default=.false.) - call get_param(param_file, mod, "LA_DEPTH_RATIO", CS%LaDepthRatio, & + call get_param(param_file, mdl, "LA_DEPTH_RATIO", CS%LaDepthRatio, & "The depth (normalized by BLD) to average Stokes drift over in \n"//& " Lanmguir number calculation, where La = sqrt(ust/Stokes).", & units="nondim",default=0.04) - call get_param(param_file, mod, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & + call get_param(param_file, mdl, "LT_ENHANCE", CS%LT_ENHANCE_FORM, & "Integer for Langmuir number mode. \n"// & " *Requires USE_LA_LI2016 to be set to True. \n"// & "Options: 0 - No Langmuir \n"// & @@ -2205,29 +2205,29 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) " 2 - Multiplied w/ adjusted La. \n"// & " 3 - Added w/ adjusted La.", & units="nondim", default=0) - call get_param(param_file, mod, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & + call get_param(param_file, mdl, "LT_ENHANCE_COEF", CS%LT_ENHANCE_COEF, & "Coefficient for Langmuir enhancement if LT_ENHANCE > 1",& units="nondim", default=0.447) - call get_param(param_file, mod, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & + call get_param(param_file, mdl, "LT_ENHANCE_EXP", CS%LT_ENHANCE_EXP, & "Exponent for Langmuir enhancement if LT_ENHANCE > 1", & units="nondim", default=-1.33) - call get_param(param_file, mod, "LT_MOD_LAC1", CS%LaC_MLDoEK, & + call get_param(param_file, mdl, "LT_MOD_LAC1", CS%LaC_MLDoEK, & "Coefficient for modification of Langmuir number due to\n"//& " MLD approaching Ekman depth if LT_ENHANCE=2.", & units="nondim", default=-0.87) - call get_param(param_file, mod, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & + call get_param(param_file, mdl, "LT_MOD_LAC2", CS%LaC_MLDoOB_stab, & "Coefficient for modification of Langmuir number due to\n"//& " MLD approaching stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) - call get_param(param_file, mod, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & + call get_param(param_file, mdl, "LT_MOD_LAC3", CS%LaC_MLDoOB_un, & "Coefficient for modification of Langmuir number due to\n"//& " MLD approaching unstable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.0) - call get_param(param_file, mod, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & + call get_param(param_file, mdl, "LT_MOD_LAC4", CS%Lac_EKoOB_stab, & "Coefficient for modification of Langmuir number due to\n"//& " ratio of Ekman to stable Obukhov depth if LT_ENHANCE=2.", & units="nondim", default=0.95) - call get_param(param_file, mod, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & + call get_param(param_file, mdl, "LT_MOD_LAC5", CS%Lac_EKoOB_un, & "Coefficient for modification of Langmuir number due to\n"// & " ratio of Ekman to unstable Obukhov depth if LT_ENHANCE=2.",& units="nondim", default=0.95) @@ -2237,7 +2237,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) endif ! This gives a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) - call log_param(param_file, mod, "EPBL_USTAR_MIN", CS%ustar_min, & + call log_param(param_file, mdl, "EPBL_USTAR_MIN", CS%ustar_min, & "The (tiny) minimum friction velocity used within the \n"//& "ePBL code, derived from OMEGA and ANGSTROM.", units="meter second-1") @@ -2282,7 +2282,7 @@ subroutine energetic_PBL_init(Time, G, GV, param_file, diag, CS) Time, 'Modified Langmuir number.', 'non-dim') - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", use_temperature, & + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", use_temperature, & "If true, temperature and salinity are used as state \n"//& "variables.", default=.true.) diff --git a/src/parameterizations/vertical/MOM_geothermal.F90 b/src/parameterizations/vertical/MOM_geothermal.F90 index b06f0d1420..5dfc4b9394 100644 --- a/src/parameterizations/vertical/MOM_geothermal.F90 +++ b/src/parameterizations/vertical/MOM_geothermal.F90 @@ -374,7 +374,7 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_geothermal" ! module name + character(len=40) :: mdl = "MOM_geothermal" ! module name character(len=200) :: inputdir, geo_file, filename, geotherm_var real :: scale integer :: i, j, isd, ied, jsd, jed, id @@ -390,8 +390,8 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) CS%Time => Time ! write parameters to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "GEOTHERMAL_SCALE", scale, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "GEOTHERMAL_SCALE", scale, & "The constant geothermal heat flux, a rescaling \n"//& "factor for the heat flux read from GEOTHERMAL_FILE, or \n"//& "0 to disable the geothermal heating.", & @@ -401,13 +401,13 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) call safe_alloc_ptr(CS%geo_heat, isd, ied, jsd, jed) ; CS%geo_heat(:,:) = 0.0 - call get_param(param_file, mod, "GEOTHERMAL_FILE", geo_file, & + call get_param(param_file, mdl, "GEOTHERMAL_FILE", geo_file, & "The file from which the geothermal heating is to be \n"//& "read, or blank to use a constant heating rate.", default=" ") - call get_param(param_file, mod, "GEOTHERMAL_THICKNESS", CS%geothermal_thick, & + call get_param(param_file, mdl, "GEOTHERMAL_THICKNESS", CS%geothermal_thick, & "The thickness over which to apply geothermal heating.", & units="m", default=0.1) - call get_param(param_file, mod, "GEOTHERMAL_DRHO_DT_INPLACE", CS%dRcv_dT_inplace, & + call get_param(param_file, mdl, "GEOTHERMAL_DRHO_DT_INPLACE", CS%dRcv_dT_inplace, & "The value of drho_dT above which geothermal heating \n"//& "simply heats water in place instead of moving it between \n"//& "isopycnal layers. This must be negative.", & @@ -416,11 +416,11 @@ subroutine geothermal_init(Time, G, param_file, diag, CS) "GEOTHERMAL_DRHO_DT_INPLACE must be negative.") if (len_trim(geo_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) filename = trim(inputdir)//trim(geo_file) - call log_param(param_file, mod, "INPUTDIR/GEOTHERMAL_FILE", filename) - call get_param(param_file, mod, "GEOTHERMAL_VARNAME", geotherm_var, & + call log_param(param_file, mdl, "INPUTDIR/GEOTHERMAL_FILE", filename) + call get_param(param_file, mdl, "GEOTHERMAL_VARNAME", geotherm_var, & "The name of the geothermal heating variable in \n"//& "GEOTHERMAL_FILE.", default="geo_heat") call read_data(filename, trim(geotherm_var), CS%geo_heat, & diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index a4b770a04f..9e35bf1bdd 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -293,7 +293,7 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) logical :: read_tideamp ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_int_tide_input" ! This module's name. + character(len=40) :: mdl = "MOM_int_tide_input" ! This module's name. character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file @@ -325,18 +325,18 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false., do_not_log=.true.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false., do_not_log=.true.) - call get_param(param_file, mod, "MIN_ZBOT_ITIDES", min_zbot_itides, & + call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& "ocean depth is less than this value.", units="m", default=0.0) - call get_param(param_file, mod, "UTIDE", utide, & + call get_param(param_file, mdl, "UTIDE", utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0) @@ -346,38 +346,38 @@ subroutine int_tide_input_init(Time, G, GV, param_file, diag, CS, itide) allocate(itide%tideamp(isd:ied,jsd:jed)) ; itide%tideamp(:,:) = utide allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed)) ; CS%TKE_itidal_coef(:,:) = 0.0 - call get_param(param_file, mod, "KAPPA_ITIDES", kappa_itides, & + call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) - call get_param(param_file, mod, "KAPPA_H2_FACTOR", kappa_h2_factor, & + call get_param(param_file, mdl, "KAPPA_H2_FACTOR", kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) - call get_param(param_file, mod, "TKE_ITIDE_MAX", CS%TKE_itide_max, & + call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source availble to mix \n"//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3) - call get_param(param_file, mod, "READ_TIDEAMP", read_tideamp, & + call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then - call get_param(param_file, mod, "TIDEAMP_FILE", tideamp_file, & + call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) - call log_param(param_file, mod, "INPUTDIR/TIDEAMP_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) call read_data(filename, 'tideamp', itide%tideamp, & domain=G%domain%mpp_domain, timelevel=1) endif - call get_param(param_file, mod, "H2_FILE", h2_file, & + call get_param(param_file, mdl, "H2_FILE", h2_file, & "The path to the file containing the sub-grid-scale \n"//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) - call log_param(param_file, mod, "INPUTDIR/H2_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call read_data(filename, 'h2', itide%h2, domain=G%domain%mpp_domain, & timelevel=1) diff --git a/src/parameterizations/vertical/MOM_kappa_shear.F90 b/src/parameterizations/vertical/MOM_kappa_shear.F90 index ab69691154..d9b40133c9 100644 --- a/src/parameterizations/vertical/MOM_kappa_shear.F90 +++ b/src/parameterizations/vertical/MOM_kappa_shear.F90 @@ -109,7 +109,7 @@ module MOM_kappa_shear end type Kappa_shear_CS ! integer :: id_clock_project, id_clock_KQ, id_clock_avg, id_clock_setup - character(len=40) :: mod = "MOM_kappa_shear" ! This module's name. + character(len=40) :: mdl = "MOM_kappa_shear" ! This module's name. #undef DEBUG #undef ADD_DIAGNOSTICS @@ -1680,77 +1680,77 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS) ! subgridscale inhomogeneity into account. ! Set default, read and log parameters - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "Parameterization of shear-driven turbulence following Jackson, Hallberg and Legg, JPO 2008") - call get_param(param_file, mod, "USE_JACKSON_PARAM", kappa_shear_init, & + call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_init, & "If true, use the Jackson-Hallberg-Legg (JPO 2008) \n"//& "shear mixing parameterization.", default=.false.) - call get_param(param_file, mod, "RINO_CRIT", CS%RiNo_crit, & + call get_param(param_file, mdl, "RINO_CRIT", CS%RiNo_crit, & "The critical Richardson number for shear mixing.", & units="nondim", default=0.25) - call get_param(param_file, mod, "SHEARMIX_RATE", CS%Shearmix_rate, & + call get_param(param_file, mdl, "SHEARMIX_RATE", CS%Shearmix_rate, & "A nondimensional rate scale for shear-driven entrainment.\n"//& "Jackson et al find values in the range of 0.085-0.089.", & units="nondim", default=0.089) - call get_param(param_file, mod, "MAX_RINO_IT", CS%max_RiNo_it, & + call get_param(param_file, mdl, "MAX_RINO_IT", CS%max_RiNo_it, & "The maximum number of iterations that may be used to \n"//& "estimate the Richardson number driven mixing.", & units="nondim", default=50) - call get_param(param_file, mod, "KD", KD_normal, default=1.0e-7, do_not_log=.true.) - call get_param(param_file, mod, "KD_KAPPA_SHEAR_0", CS%kappa_0, & + call get_param(param_file, mdl, "KD", KD_normal, default=1.0e-7, do_not_log=.true.) + call get_param(param_file, mdl, "KD_KAPPA_SHEAR_0", CS%kappa_0, & "The background diffusivity that is used to smooth the \n"//& "density and shear profiles before solving for the \n"//& "diffusivities. Defaults to value of KD.", units="m2 s-1", default=KD_normal) - call get_param(param_file, mod, "FRI_CURVATURE", CS%FRi_curvature, & + call get_param(param_file, mdl, "FRI_CURVATURE", CS%FRi_curvature, & "The nondimensional curvature of the function of the \n"//& "Richardson number in the kappa source term in the \n"//& "Jackson et al. scheme.", units="nondim", default=-0.97) - call get_param(param_file, mod, "TKE_N_DECAY_CONST", CS%C_N, & + call get_param(param_file, mdl, "TKE_N_DECAY_CONST", CS%C_N, & "The coefficient for the decay of TKE due to \n"//& "stratification (i.e. proportional to N*tke). \n"//& "The values found by Jackson et al. are 0.24-0.28.", & units="nondim", default=0.24) -! call get_param(param_file, mod, "LAYER_KAPPA_STAGGER", CS%layer_stagger, & +! call get_param(param_file, mdl, "LAYER_KAPPA_STAGGER", CS%layer_stagger, & ! default=.false.) - call get_param(param_file, mod, "TKE_SHEAR_DECAY_CONST", CS%C_S, & + call get_param(param_file, mdl, "TKE_SHEAR_DECAY_CONST", CS%C_S, & "The coefficient for the decay of TKE due to shear (i.e. \n"//& "proportional to |S|*tke). The values found by Jackson \n"//& "et al. are 0.14-0.12.", units="nondim", default=0.14) - call get_param(param_file, mod, "KAPPA_BUOY_SCALE_COEF", CS%lambda, & + call get_param(param_file, mdl, "KAPPA_BUOY_SCALE_COEF", CS%lambda, & "The coefficient for the buoyancy length scale in the \n"//& "kappa equation. The values found by Jackson et al. are \n"//& "in the range of 0.81-0.86.", units="nondim", default=0.82) - call get_param(param_file, mod, "KAPPA_N_OVER_S_SCALE_COEF2", CS%lambda2_N_S, & + call get_param(param_file, mdl, "KAPPA_N_OVER_S_SCALE_COEF2", CS%lambda2_N_S, & "The square of the ratio of the coefficients of the \n"//& "buoyancy and shear scales in the diffusivity equation, \n"//& "Set this to 0 (the default) to eliminate the shear scale. \n"//& "This is only used if USE_JACKSON_PARAM is true.", & units="nondim", default=0.0) - call get_param(param_file, mod, "KAPPA_SHEAR_TOL_ERR", CS%kappa_tol_err, & + call get_param(param_file, mdl, "KAPPA_SHEAR_TOL_ERR", CS%kappa_tol_err, & "The fractional error in kappa that is tolerated. \n"//& "Iteration stops when changes between subsequent \n"//& "iterations are smaller than this everywhere in a \n"//& "column. The peak diffusivities usually converge most \n"//& "rapidly, and have much smaller errors than this.", & units="nondim", default=0.1) - call get_param(param_file, mod, "TKE_BACKGROUND", CS%TKE_bg, & + call get_param(param_file, mdl, "TKE_BACKGROUND", CS%TKE_bg, & "A background level of TKE used in the first iteration \n"//& "of the kappa equation. TKE_BACKGROUND could be 0.", & units="m2 s-2", default=0.0) - call get_param(param_file, mod, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & + call get_param(param_file, mdl, "KAPPA_SHEAR_ELIM_MASSLESS", CS%eliminate_massless, & "If true, massless layers are merged with neighboring \n"//& "massive layers in this calculation. The default is \n"//& "true and I can think of no good reason why it should \n"//& "be false. This is only used if USE_JACKSON_PARAM is true.", & default=.true.) - call get_param(param_file, mod, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & + call get_param(param_file, mdl, "MAX_KAPPA_SHEAR_IT", CS%max_KS_it, & "The maximum number of iterations that may be used to \n"//& "estimate the time-averaged diffusivity.", units="nondim", & default=13) - call get_param(param_file, mod, "PRANDTL_TURB", CS%Prandtl_turb, & + call get_param(param_file, mdl, "PRANDTL_TURB", CS%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0, do_not_log=.true.) - call get_param(param_file, mod, "DEBUG_KAPPA_SHEAR", CS%debug, & + call get_param(param_file, mdl, "DEBUG_KAPPA_SHEAR", CS%debug, & "If true, write debugging data for the kappa-shear code. \n"//& "Caution: this option is _very_ verbose and should only \n"//& "be used in single-column mode!", default=.false.) @@ -1762,7 +1762,7 @@ logical function kappa_shear_init(Time, G, GV, param_file, diag, CS) CS%nkml = 1 if (GV%nkml>0) then - call get_param(param_file, mod, "KAPPA_SHEAR_MERGE_ML",merge_mixedlayer, & + call get_param(param_file, mdl, "KAPPA_SHEAR_MERGE_ML",merge_mixedlayer, & "If true, combine the mixed layers together before \n"//& "solving the kappa-shear equations.", default=.true.) if (merge_mixedlayer) CS%nkml = GV%nkml @@ -1791,7 +1791,7 @@ logical function kappa_shear_is_used(param_file) ! This function allows other modules to know whether this parameterization will ! be used without needing to duplicate the log entry. type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - call get_param(param_file, mod, "USE_JACKSON_PARAM", kappa_shear_is_used, & + call get_param(param_file, mdl, "USE_JACKSON_PARAM", kappa_shear_is_used, & default=.false., do_not_log = .true.) end function kappa_shear_is_used diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 41ab56d3a2..e451e564a6 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -497,7 +497,7 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) character(len=200) :: inputdir ! The directory where NetCDF input files character(len=240) :: filename character(len=200) :: tmpstr - character(len=40) :: mod = "MOM_opacity" + character(len=40) :: mdl = "MOM_opacity" character(len=40) :: bandnum, shortname character(len=200) :: longname character(len=40) :: scheme_string @@ -516,17 +516,17 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%tracer_flow_CSp => tracer_flow ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") ! parameters for CHL_A routines - call get_param(param_file, mod, "VAR_PEN_SW", CS%var_pen_sw, & + call get_param(param_file, mdl, "VAR_PEN_SW", CS%var_pen_sw, & "If true, use one of the CHL_A schemes specified by \n"//& "OPACITY_SCHEME to determine the e-folding depth of \n"//& "incoming short wave radiation.", default=.false.) CS%opacity_scheme = NO_SCHEME ; scheme_string = "" if (CS%var_pen_sw) then - call get_param(param_file, mod, "OPACITY_SCHEME", tmpstr, & + call get_param(param_file, mdl, "OPACITY_SCHEME", tmpstr, & "This character string specifies how chlorophyll \n"//& "concentrations are translated into opacities. Currently \n"//& "valid options include:\n"//& @@ -552,27 +552,27 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%opacity_scheme = MANIZZA_05 ; scheme_string = MANIZZA_05_STRING endif - call get_param(param_file, mod, "CHL_FROM_FILE", CS%chl_from_file, & + call get_param(param_file, mdl, "CHL_FROM_FILE", CS%chl_from_file, & "If true, chl_a is read from a file.", default=.true.) if (CS%chl_from_file) then call time_interp_external_init() - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") - call get_param(param_file, mod, "CHL_FILE", CS%chl_file, & + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "CHL_FILE", CS%chl_file, & "CHL_FILE is the file containing chl_a concentrations in \n"//& "the variable CHL_A. It is used when VAR_PEN_SW and \n"//& "CHL_FROM_FILE are true.", fail_if_missing=.true.) filename = trim(slasher(inputdir))//trim(CS%chl_file) - call log_param(param_file, mod, "INPUTDIR/CHL_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/CHL_FILE", filename) CS%sbc_chl = init_external_field(filename,'CHL_A',domain=G%Domain%mpp_domain) endif - call get_param(param_file, mod, "BLUE_FRAC_SW", CS%blue_frac, & + call get_param(param_file, mdl, "BLUE_FRAC_SW", CS%blue_frac, & "The fraction of the penetrating shortwave radiation \n"//& "that is in the blue band.", default=0.5, units="nondim") else - call get_param(param_file, mod, "EXP_OPACITY_SCHEME", tmpstr, & + call get_param(param_file, mdl, "EXP_OPACITY_SCHEME", tmpstr, & "This character string specifies which exponential \n"//& "opacity scheme to utilize. Currently \n"//& "valid options include:\n"//& @@ -589,17 +589,17 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) end select call MOM_mesg('opacity_init: opacity scheme set to "'//trim(tmpstr)//'".', 5) endif - call get_param(param_file, mod, "PEN_SW_SCALE", CS%pen_sw_scale, & + call get_param(param_file, mdl, "PEN_SW_SCALE", CS%pen_sw_scale, & "The vertical absorption e-folding depth of the \n"//& "penetrating shortwave radiation.", units="m", default=0.0) !BGR/ Added for opacity_scheme==double_exp read in 2nd exp-decay and fraction if (CS%Opacity_scheme == DOUBLE_EXP ) then - call get_param(param_file, mod, "PEN_SW_SCALE_2ND", CS%pen_sw_scale_2nd, & + call get_param(param_file, mdl, "PEN_SW_SCALE_2ND", CS%pen_sw_scale_2nd, & "The (2nd) vertical absorption e-folding depth of the \n"//& "penetrating shortwave radiation \n"//& "(use if SW_EXP_MODE==double.)",& units="m", default=0.0) - call get_param(param_file, mod, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & + call get_param(param_file, mdl, "SW_1ST_EXP_RATIO", CS%sw_1st_exp_ratio, & "The fraction of 1st vertical absorption e-folding depth \n"//& "penetrating shortwave radiation if SW_EXP_MODE==double.",& units="m", default=0.0) @@ -608,12 +608,12 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) CS%pen_sw_scale_2nd = 0.0 CS%sw_1st_exp_ratio = 1.0 endif - call get_param(param_file, mod, "PEN_SW_FRAC", CS%pen_sw_frac, & + call get_param(param_file, mdl, "PEN_SW_FRAC", CS%pen_sw_frac, & "The fraction of the shortwave radiation that penetrates \n"//& "below the surface.", units="nondim", default=0.0) endif - call get_param(param_file, mod, "PEN_SW_NBANDS", optics%nbands, & + call get_param(param_file, mdl, "PEN_SW_NBANDS", optics%nbands, & "The number of bands of penetrating shortwave radiation.", & default=1) if (CS%Opacity_scheme == DOUBLE_EXP ) then @@ -647,7 +647,7 @@ subroutine opacity_init(Time, G, param_file, diag, tracer_flow, CS, optics) endif endif - call get_param(param_file, mod, "OPACITY_LAND_VALUE", CS%opacity_land_value, & + call get_param(param_file, mdl, "OPACITY_LAND_VALUE", CS%opacity_land_value, & "The value to use for opacity over land. The default is \n"//& "10 m-1 - a value for muddy water.", units="m-1", default=10.0) diff --git a/src/parameterizations/vertical/MOM_regularize_layers.F90 b/src/parameterizations/vertical/MOM_regularize_layers.F90 index 248e39e6d1..9aee9fb2ac 100644 --- a/src/parameterizations/vertical/MOM_regularize_layers.F90 +++ b/src/parameterizations/vertical/MOM_regularize_layers.F90 @@ -939,7 +939,7 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_regularize_layers" ! This module's name. + character(len=40) :: mdl = "MOM_regularize_layers" ! This module's name. logical :: use_temperature integer :: isd, ied, jsd, jed isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -954,23 +954,23 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) CS%Time => Time ! Set default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "REGULARIZE_SURFACE_LAYERS", CS%regularize_surface_layers, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "REGULARIZE_SURFACE_LAYERS", CS%regularize_surface_layers, & "If defined, vertically restructure the near-surface \n"//& "layers when they have too much lateral variations to \n"//& "allow for sensible lateral barotropic transports.", & default=.false.) if (CS%regularize_surface_layers) then - call get_param(param_file, mod, "REGULARIZE_SURFACE_DETRAIN", CS%reg_sfc_detrain, & + call get_param(param_file, mdl, "REGULARIZE_SURFACE_DETRAIN", CS%reg_sfc_detrain, & "If true, allow the buffer layers to detrain into the \n"//& "interior as a part of the restructuring when \n"//& "REGULARIZE_SURFACE_LAYERS is true.", default=.true.) endif - call get_param(param_file, mod, "HMIX_MIN", CS%Hmix_min, & + call get_param(param_file, mdl, "HMIX_MIN", CS%Hmix_min, & "The minimum mixed layer depth if the mixed layer depth \n"//& "is determined dynamically.", units="m", default=0.0) - call get_param(param_file, mod, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & + call get_param(param_file, mdl, "REG_SFC_DEFICIT_TOLERANCE", CS%h_def_tol1, & "The value of the relative thickness deficit at which \n"//& "to start modifying the layer structure when \n"//& "REGULARIZE_SURFACE_LAYERS is true.", units="nondim", & @@ -979,12 +979,12 @@ subroutine regularize_layers_init(Time, G, param_file, diag, CS) CS%h_def_tol3 = 0.3 + 0.7*CS%h_def_tol1 CS%h_def_tol4 = 0.5 + 0.5*CS%h_def_tol1 - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) ! if (.not. CS%debug) & -! call get_param(param_file, mod, "DEBUG_CONSERVATION", CS%debug, & +! call get_param(param_file, mdl, "DEBUG_CONSERVATION", CS%debug, & ! "If true, monitor conservation and extrema.", default=.false.) - call get_param(param_file, mod, "ALLOW_CLOCKS_IN_OMP_LOOPS", & + call get_param(param_file, mdl, "ALLOW_CLOCKS_IN_OMP_LOOPS", & CS%allow_clocks_in_omp_loops, & "If true, clocks can be called from inside loops that can \n"//& "be threaded. To run with multiple threads, set to False.", & diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 9d49a91cbe..df750523cf 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -2527,7 +2527,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp logical :: read_tideamp, ML_use_omega ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_set_diffusivity" ! This module's name. + character(len=40) :: mdl = "MOM_set_diffusivity" ! This module's name. character(len=20) :: tmpstr character(len=200) :: filename, tideamp_file, h2_file, Niku_TKE_input_file real :: Niku_scale ! local variable for scaling the Nikurashin TKE flux data @@ -2556,20 +2556,20 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "INPUTDIR", CS%inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", CS%inputdir, default=".") CS%inputdir = slasher(CS%inputdir) - call get_param(param_file, mod, "FLUX_RI_MAX", CS%FluxRi_max, & + call get_param(param_file, mdl, "FLUX_RI_MAX", CS%FluxRi_max, & "The flux Richardson number where the stratification is \n"//& "large enough that N2 > omega2. The full expression for \n"//& "the Flux Richardson number is usually \n"//& "FLUX_RI_MAX*N2/(N2+OMEGA2).", default=0.2) - call get_param(param_file, mod, "OMEGA", CS%omega, & + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) - call get_param(param_file, mod, "ML_RADIATION", CS%ML_radiation, & + call get_param(param_file, mdl, "ML_RADIATION", CS%ML_radiation, & "If true, allow a fraction of TKE available from wind \n"//& "work to penetrate below the base of the mixed layer \n"//& "with a vertical decay scale determined by the minimum \n"//& @@ -2579,33 +2579,33 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom + GV%H_subroundoff) - call get_param(param_file, mod, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & + call get_param(param_file, mdl, "ML_RAD_EFOLD_COEFF", CS%ML_rad_efold_coeff, & "A coefficient that is used to scale the penetration \n"//& "depth for turbulence below the base of the mixed layer. \n"//& "This is only used if ML_RADIATION is true.", units="nondim", & default=0.2) - call get_param(param_file, mod, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & + call get_param(param_file, mdl, "ML_RAD_KD_MAX", CS%ML_rad_kd_max, & "The maximum diapycnal diffusivity due to turbulence \n"//& "radiated from the base of the mixed layer. \n"//& "This is only used if ML_RADIATION is true.", units="m2 s-1", & default=1.0e-3) - call get_param(param_file, mod, "ML_RAD_COEFF", CS%ML_rad_coeff, & + call get_param(param_file, mdl, "ML_RAD_COEFF", CS%ML_rad_coeff, & "The coefficient which scales MSTAR*USTAR^3 to obtain \n"//& "the energy available for mixing below the base of the \n"//& "mixed layer. This is only used if ML_RADIATION is true.", & units="nondim", default=0.2) - call get_param(param_file, mod, "ML_RAD_APPLY_TKE_DECAY", CS%ML_rad_TKE_decay, & + call get_param(param_file, mdl, "ML_RAD_APPLY_TKE_DECAY", CS%ML_rad_TKE_decay, & "If true, apply the same exponential decay to ML_rad as \n"//& "is applied to the other surface sources of TKE in the \n"//& "mixed layer code. This is only used if ML_RADIATION is true.",& default=.true.) - call get_param(param_file, mod, "MSTAR", CS%mstar, & + call get_param(param_file, mdl, "MSTAR", CS%mstar, & "The ratio of the friction velocity cubed to the TKE \n"//& "input to the mixed layer.", "units=nondim", default=1.2) - call get_param(param_file, mod, "TKE_DECAY", CS%TKE_decay, & + call get_param(param_file, mdl, "TKE_DECAY", CS%TKE_decay, & "The ratio of the natural Ekman depth to the TKE decay scale.", & units="nondim", default=2.5) - call get_param(param_file, mod, "ML_USE_OMEGA", ML_use_omega, & + call get_param(param_file, mdl, "ML_USE_OMEGA", ML_use_omega, & "If true, use the absolute rotation rate instead of the \n"//& "vertical component of rotation when setting the decay \n"//& "scale for turbulence.", default=.false., do_not_log=.true.) @@ -2614,29 +2614,29 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mod, "ML_OMEGA_FRAC", CS%ML_omega_frac, & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%ML_omega_frac, & "When setting the decay scale for turbulence, use this \n"//& "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) endif - call get_param(param_file, mod, "BOTTOMDRAGLAW", CS%bottomdraglaw, & + call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& "may be an assumed value or it may be based on the \n"//& "actual velocity in the bottommost HBBL, depending on \n"//& "LINEAR_DRAG.", default=.true.) if (CS%bottomdraglaw) then - call get_param(param_file, mod, "CDRAG", CS%cdrag, & + call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "The drag coefficient relating the magnitude of the \n"//& "velocity field to the bottom stress. CDRAG is only used \n"//& "if BOTTOMDRAGLAW is true.", units="nondim", default=0.003) - call get_param(param_file, mod, "BBL_EFFIC", CS%BBL_effic, & + call get_param(param_file, mdl, "BBL_EFFIC", CS%BBL_effic, & "The efficiency with which the energy extracted by \n"//& "bottom drag drives BBL diffusion. This is only \n"//& "used if BOTTOMDRAGLAW is true.", units="nondim", default=0.20) - call get_param(param_file, mod, "BBL_MIXING_MAX_DECAY", decay_length, & + call get_param(param_file, mdl, "BBL_MIXING_MAX_DECAY", decay_length, & "The maximum decay scale for the BBL diffusion, or 0 \n"//& "to allow the mixing to penetrate as far as \n"//& "stratification and rotation permit. The default is 0. \n"//& @@ -2645,17 +2645,17 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%IMax_decay = 1.0/200.0 if (decay_length > 0.0) CS%IMax_decay = 1.0/decay_length - call get_param(param_file, mod, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & + call get_param(param_file, mdl, "BBL_MIXING_AS_MAX", CS%BBL_mixing_as_max, & "If true, take the maximum of the diffusivity from the \n"//& "BBL mixing and the other diffusivities. Otherwise, \n"//& "diffusiviy from the BBL_mixing is simply added.", & default=.true.) - call get_param(param_file, mod, "USE_LOTW_BBL_DIFFUSIVITY", CS%use_LOTW_BBL_diffusivity, & + call get_param(param_file, mdl, "USE_LOTW_BBL_DIFFUSIVITY", CS%use_LOTW_BBL_diffusivity, & "If true, uses a simple, imprecise but non-coordinate dependent, model\n"//& "of BBL mixing diffusivity based on Law of the Wall. Otherwise, uses\n"//& "the original BBL scheme.", default=.false.) if (CS%use_LOTW_BBL_diffusivity) then - call get_param(param_file, mod, "LOTW_BBL_USE_OMEGA", CS%LOTW_BBL_use_omega, & + call get_param(param_file, mdl, "LOTW_BBL_USE_OMEGA", CS%LOTW_BBL_use_omega, & "If true, use the maximum of Omega and N for the TKE to diffusion\n"//& "calculation. Otherwise, N is N.", default=.true.) endif @@ -2664,38 +2664,38 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif CS%id_Kd_BBL = register_diag_field('ocean_model','Kd_BBL',diag%axesTi,Time, & 'Bottom Boundary Layer Diffusivity', 'meter2 sec-1') - call get_param(param_file, mod, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & + call get_param(param_file, mdl, "SIMPLE_TKE_TO_KD", CS%simple_TKE_to_Kd, & "If true, uses a simple estimate of Kd/TKE that will\n"//& "work for arbitrary vertical coordinates. If false,\n"//& "calculates Kd/TKE and bounds based on exact energetics/n"//& "for an isopycnal layer-formulation.", & default=.false.) - call get_param(param_file, mod, "BRYAN_LEWIS_DIFFUSIVITY", & + call get_param(param_file, mdl, "BRYAN_LEWIS_DIFFUSIVITY", & CS%Bryan_Lewis_diffusivity, & "If true, use a Bryan & Lewis (JGR 1979) like tanh \n"//& "profile of background diapycnal diffusivity with depth.", & default=.false.) if (CS%Bryan_Lewis_diffusivity) then - call get_param(param_file, mod, "KD_BRYAN_LEWIS_DEEP", & + call get_param(param_file, mdl, "KD_BRYAN_LEWIS_DEEP", & CS%Kd_Bryan_Lewis_deep, & "The abyssal value of a Bryan-Lewis diffusivity profile. \n"//& "KD_BRYAN_LEWIS_DEEP is only used if \n"//& "BRYAN_LEWIS_DIFFUSIVITY is true.", units="m2 s-1", & fail_if_missing=.true.) - call get_param(param_file, mod, "KD_BRYAN_LEWIS_SURFACE", & + call get_param(param_file, mdl, "KD_BRYAN_LEWIS_SURFACE", & CS%Kd_Bryan_Lewis_surface, & "The surface value of a Bryan-Lewis diffusivity profile. \n"//& "KD_BRYAN_LEWIS_SURFACE is only used if \n"//& "BRYAN_LEWIS_DIFFUSIVITY is true.", units="m2 s-1", & fail_if_missing=.true.) - call get_param(param_file, mod, "BRYAN_LEWIS_DEPTH_CENT", & + call get_param(param_file, mdl, "BRYAN_LEWIS_DEPTH_CENT", & CS%Bryan_Lewis_depth_cent, & "The depth about which the transition in the Bryan-Lewis \n"//& "profile is centered. BRYAN_LEWIS_DEPTH_CENT is only \n"//& "used if BRYAN_LEWIS_DIFFUSIVITY is true.", units="m", & fail_if_missing=.true.) - call get_param(param_file, mod, "BRYAN_LEWIS_WIDTH_TRANS", & + call get_param(param_file, mdl, "BRYAN_LEWIS_WIDTH_TRANS", & CS%Bryan_Lewis_width_trans, & "The width of the transition in the Bryan-Lewis \n"//& "profile. BRYAN_LEWIS_WIDTH_TRANS is only \n"//& @@ -2703,12 +2703,12 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp fail_if_missing=.true.) endif - call get_param(param_file, mod, "HENYEY_IGW_BACKGROUND", & + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND", & CS%Henyey_IGW_background, & "If true, use a latitude-dependent scaling for the near \n"//& "surface background diffusivity, as described in \n"//& "Harrison & Hallberg, JPO 2008.", default=.false.) - call get_param(param_file, mod, "HENYEY_IGW_BACKGROUND_NEW", & + call get_param(param_file, mdl, "HENYEY_IGW_BACKGROUND_NEW", & CS%Henyey_IGW_background_new, & "If true, use a better latitude-dependent scaling for the\n"//& "background diffusivity, as described in \n"//& @@ -2717,48 +2717,48 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp "set_diffusivity_init: HENYEY_IGW_BACKGROUND and HENYEY_IGW_BACKGROUND_NEW "// & "are mutually exclusive. Set only one or none.") if (CS%Henyey_IGW_background) & - call get_param(param_file, mod, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & + call get_param(param_file, mdl, "HENYEY_N0_2OMEGA", CS%N0_2Omega, & "The ratio of the typical Buoyancy frequency to twice \n"//& "the Earth's rotation period, used with the Henyey \n"//& "scaling from the mixing.", units="nondim", default=20.0) - call get_param(param_file, mod, "N2_FLOOR_IOMEGA2", CS%N2_FLOOR_IOMEGA2, & + call get_param(param_file, mdl, "N2_FLOOR_IOMEGA2", CS%N2_FLOOR_IOMEGA2, & "The floor applied to N2(k) scaled by Omega^2:\n"//& "\tIf =0., N2(k) is simply positive definite.\n"//& "\tIf =1., N2(k) > Omega^2 everywhere.", units="nondim", & default=1.0) - call get_param(param_file, mod, "KD_TANH_LAT_FN", & + call get_param(param_file, mdl, "KD_TANH_LAT_FN", & CS%Kd_tanh_lat_fn, & "If true, use a tanh dependence of Kd_sfc on latitude, \n"//& "like CM2.1/CM2M. There is no physical justification \n"//& "for this form, and it can not be used with \n"//& "HENYEY_IGW_BACKGROUND.", default=.false.) if (CS%Kd_tanh_lat_fn) & - call get_param(param_file, mod, "KD_TANH_LAT_SCALE", & + call get_param(param_file, mdl, "KD_TANH_LAT_SCALE", & CS%Kd_tanh_lat_scale, & "A nondimensional scaling for the range ofdiffusivities \n"//& "with KD_TANH_LAT_FN. Valid values are in the range of \n"//& "-2 to 2; 0.4 reproduces CM2M.", units="nondim", default=0.0) - call get_param(param_file, mod, "KV", CS%Kv, & + call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mod, "KD", CS%Kd, & + call get_param(param_file, mdl, "KD", CS%Kd, & "The background diapycnal diffusivity of density in the \n"//& "interior. Zero or the molecular value, ~1e-7 m2 s-1, \n"//& "may be used.", units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mod, "KD_MIN", CS%Kd_min, & + call get_param(param_file, mdl, "KD_MIN", CS%Kd_min, & "The minimum diapycnal diffusivity.", & units="m2 s-1", default=0.01*CS%Kd) - call get_param(param_file, mod, "KD_MAX", CS%Kd_max, & + call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & "The maximum permitted increment for the diapycnal \n"//& "diffusivity from TKE-based parameterizations, or a \n"//& "negative value for no limit.", units="m2 s-1", default=-1.0) if (CS%simple_TKE_to_Kd .and. CS%Kd_max<=0.) call MOM_error(FATAL, & "set_diffusivity_init: To use SIMPLE_TKE_TO_KD, KD_MAX must be set to >0.") - call get_param(param_file, mod, "KD_ADD", CS%Kd_add, & + call get_param(param_file, mdl, "KD_ADD", CS%Kd_add, & "A uniform diapycnal diffusivity that is added \n"//& "everywhere without any filtering or scaling.", & units="m2 s-1", default=0.0) @@ -2768,32 +2768,32 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%bulkmixedlayer) then ! Check that Kdml is not set when using bulk mixed layer - call get_param(param_file, mod, "KDML", CS%Kdml, default=-1.) + call get_param(param_file, mdl, "KDML", CS%Kdml, default=-1.) if (CS%Kdml>0.) call MOM_error(FATAL, & "set_diffusivity_init: KDML cannot be set when using"// & "bulk mixed layer.") CS%Kdml = CS%Kd ! This is not used with a bulk mixed layer, but also ! cannot be a NaN. else - call get_param(param_file, mod, "KDML", CS%Kdml, & + call get_param(param_file, mdl, "KDML", CS%Kdml, & "If BULKMIXEDLAYER is false, KDML is the elevated \n"//& "diapycnal diffusivity in the topmost HMIX of fluid. \n"//& "KDML is only used if BULKMIXEDLAYER is false.", & units="m2 s-1", default=CS%Kd) - call get_param(param_file, mod, "HMIX_FIXED", CS%Hmix, & + call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& "mixed layer is not used.", units="m", fail_if_missing=.true.) endif - call get_param(param_file, mod, "DEBUG", CS%debug, & + call get_param(param_file, mdl, "DEBUG", CS%debug, & "If true, write out verbose debugging data.", default=.false.) - call get_param(param_file, mod, "INT_TIDE_DISSIPATION", CS%Int_tide_dissipation, & + call get_param(param_file, mdl, "INT_TIDE_DISSIPATION", CS%Int_tide_dissipation, & "If true, use an internal tidal dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of St. Laurent \n"//& "et al. (2002) and Simmons et al. (2004).", default=.false.) if (CS%Int_tide_dissipation) then - call get_param(param_file, mod, "INT_TIDE_PROFILE", tmpstr, & + call get_param(param_file, mdl, "INT_TIDE_PROFILE", tmpstr, & "INT_TIDE_PROFILE selects the vertical profile of energy \n"//& "dissipation with INT_TIDE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& @@ -2811,13 +2811,13 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp end select endif - call get_param(param_file, mod, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & + call get_param(param_file, mdl, "LEE_WAVE_DISSIPATION", CS%Lee_wave_dissipation, & "If true, use an lee wave driven dissipation scheme to \n"//& "drive diapycnal mixing, along the lines of Nikurashin \n"//& "(2010) and using the St. Laurent et al. (2002) \n"//& "and Simmons et al. (2004) vertical profile", default=.false.) if (CS%lee_wave_dissipation) then - call get_param(param_file, mod, "LEE_WAVE_PROFILE", tmpstr, & + call get_param(param_file, mdl, "LEE_WAVE_PROFILE", tmpstr, & "LEE_WAVE_PROFILE selects the vertical profile of energy \n"//& "dissipation with LEE_WAVE_DISSIPATION. Valid values are:\n"//& "\t STLAURENT_02 - Use the St. Laurent et al exponential \n"//& @@ -2835,7 +2835,7 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp end select endif - call get_param(param_file, mod, "INT_TIDE_LOWMODE_DISSIPATION", CS%Lowmode_itidal_dissipation, & + call get_param(param_file, mdl, "INT_TIDE_LOWMODE_DISSIPATION", CS%Lowmode_itidal_dissipation, & "If true, consider mixing due to breaking low modes that \n"//& "have been remotely generated; as with itidal drag on the \n"//& "barotropic tide, use an internal tidal dissipation scheme to \n"//& @@ -2844,52 +2844,52 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if ((CS%Int_tide_dissipation .and. (CS%int_tide_profile == POLZIN_09)) .or. & (CS%lee_wave_dissipation .and. (CS%lee_wave_profile == POLZIN_09))) then - call get_param(param_file, mod, "NU_POLZIN", CS%Nu_Polzin, & + call get_param(param_file, mdl, "NU_POLZIN", CS%Nu_Polzin, & "When the Polzin decay profile is used, this is a \n"//& "non-dimensional constant in the expression for the \n"//& "vertical scale of decay for the tidal energy dissipation.", & units="nondim", default=0.0697) - call get_param(param_file, mod, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & + call get_param(param_file, mdl, "NBOTREF_POLZIN", CS%Nbotref_Polzin, & "When the Polzin decay profile is used, this is the \n"//& "Rreference value of the buoyancy frequency at the ocean \n"//& "bottom in the Polzin formulation for the vertical \n"//& "scale of decay for the tidal energy dissipation.", & units="s-1", default=9.61e-4) - call get_param(param_file, mod, "POLZIN_DECAY_SCALE_FACTOR", & + call get_param(param_file, mdl, "POLZIN_DECAY_SCALE_FACTOR", & CS%Polzin_decay_scale_factor, & "When the Polzin decay profile is used, this is a \n"//& "scale factor for the vertical scale of decay of the tidal \n"//& "energy dissipation.", default=1.0, units="nondim") - call get_param(param_file, mod, "POLZIN_SCALE_MAX_FACTOR", & + call get_param(param_file, mdl, "POLZIN_SCALE_MAX_FACTOR", & CS%Polzin_decay_scale_max_factor, & "When the Polzin decay profile is used, this is a factor \n"//& "to limit the vertical scale of decay of the tidal \n"//& "energy dissipation to POLZIN_DECAY_SCALE_MAX_FACTOR \n"//& "times the depth of the ocean.", units="nondim", default=1.0) - call get_param(param_file, mod, "POLZIN_MIN_DECAY_SCALE", CS%Polzin_min_decay_scale, & + call get_param(param_file, mdl, "POLZIN_MIN_DECAY_SCALE", CS%Polzin_min_decay_scale, & "When the Polzin decay profile is used, this is the \n"//& "minimum vertical decay scale for the vertical profile\n"//& "of internal tide dissipation with the Polzin (2009) formulation", & units="m", default=0.0) endif - call get_param(param_file, mod, "USER_CHANGE_DIFFUSIVITY", CS%user_change_diff, & + call get_param(param_file, mdl, "USER_CHANGE_DIFFUSIVITY", CS%user_change_diff, & "If true, call user-defined code to change the diffusivity.", & default=.false.) - call get_param(param_file, mod, "DISSIPATION_MIN", CS%dissip_min, & + call get_param(param_file, mdl, "DISSIPATION_MIN", CS%dissip_min, & "The minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor).", units="W m-3", default=0.0) - call get_param(param_file, mod, "DISSIPATION_N0", CS%dissip_N0, & + call get_param(param_file, mdl, "DISSIPATION_N0", CS%dissip_N0, & "The intercept when N=0 of the N-dependent expression \n"//& "used to set a minimum dissipation by which to determine \n"//& "a lower bound of Kd (a floor): A in eps_min = A + B*N.", & units="W m-3", default=0.0) - call get_param(param_file, mod, "DISSIPATION_N1", CS%dissip_N1, & + call get_param(param_file, mdl, "DISSIPATION_N1", CS%dissip_N1, & "The coefficient multiplying N, following Gargett, used to \n"//& "set a minimum dissipation by which to determine a lower \n"//& "bound of Kd (a floor): B in eps_min = A + B*N", & units="J m-3", default=0.0) - call get_param(param_file, mod, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & + call get_param(param_file, mdl, "DISSIPATION_KD_MIN", CS%dissip_Kd_min, & "The minimum vertical diffusivity applied as a floor.", & units="m2 s-1", default=0.0) @@ -2900,19 +2900,19 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp CS%dissip_N2 = CS%dissip_Kd_min * GV%Rho0 / CS%FluxRi_max if (CS%Int_tide_dissipation .or. CS%Lee_wave_dissipation) then - call get_param(param_file, mod, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & + call get_param(param_file, mdl, "INT_TIDE_DECAY_SCALE", CS%Int_tide_decay_scale, & "The decay scale away from the bottom for tidal TKE with \n"//& "the new coding when INT_TIDE_DISSIPATION is used.", & units="m", default=0.0) - call get_param(param_file, mod, "MU_ITIDES", CS%Mu_itides, & + call get_param(param_file, mdl, "MU_ITIDES", CS%Mu_itides, & "A dimensionless turbulent mixing efficiency used with \n"//& "INT_TIDE_DISSIPATION, often 0.2.", units="nondim", default=0.2) - call get_param(param_file, mod, "GAMMA_ITIDES", CS%Gamma_itides, & + call get_param(param_file, mdl, "GAMMA_ITIDES", CS%Gamma_itides, & "The fraction of the internal tidal energy that is \n"//& "dissipated locally with INT_TIDE_DISSIPATION. \n"//& "THIS NAME COULD BE BETTER.", & units="nondim", default=0.3333) - call get_param(param_file, mod, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & + call get_param(param_file, mdl, "MIN_ZBOT_ITIDES", CS%min_zbot_itides, & "Turn off internal tidal dissipation when the total \n"//& "ocean depth is less than this value.", units="m", default=0.0) @@ -2921,43 +2921,43 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp call safe_alloc_ptr(CS%TKE_itidal,isd,ied,jsd,jed) call safe_alloc_ptr(CS%mask_itidal,isd,ied,jsd,jed) ; CS%mask_itidal(:,:) = 1.0 - call get_param(param_file, mod, "KAPPA_ITIDES", CS%kappa_itides, & + call get_param(param_file, mdl, "KAPPA_ITIDES", CS%kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. \n"//& "The default is 2pi/10 km, as in St.Laurent et al. 2002.", & units="m-1", default=8.e-4*atan(1.0)) - call get_param(param_file, mod, "UTIDE", CS%utide, & + call get_param(param_file, mdl, "UTIDE", CS%utide, & "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0) call safe_alloc_ptr(CS%tideamp,is,ie,js,je) ; CS%tideamp(:,:) = CS%utide - call get_param(param_file, mod, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & + call get_param(param_file, mdl, "KAPPA_H2_FACTOR", CS%kappa_h2_factor, & "A scaling factor for the roughness amplitude with n"//& "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) - call get_param(param_file, mod, "TKE_ITIDE_MAX", CS%TKE_itide_max, & + call get_param(param_file, mdl, "TKE_ITIDE_MAX", CS%TKE_itide_max, & "The maximum internal tide energy source availble to mix \n"//& "above the bottom boundary layer with INT_TIDE_DISSIPATION.", & units="W m-2", default=1.0e3) - call get_param(param_file, mod, "READ_TIDEAMP", read_tideamp, & + call get_param(param_file, mdl, "READ_TIDEAMP", read_tideamp, & "If true, read a file (given by TIDEAMP_FILE) containing \n"//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (read_tideamp) then - call get_param(param_file, mod, "TIDEAMP_FILE", tideamp_file, & + call get_param(param_file, mdl, "TIDEAMP_FILE", tideamp_file, & "The path to the file containing the spatially varying \n"//& "tidal amplitudes with INT_TIDE_DISSIPATION.", default="tideamp.nc") filename = trim(CS%inputdir) // trim(tideamp_file) - call log_param(param_file, mod, "INPUTDIR/TIDEAMP_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) call read_data(filename, 'tideamp', CS%tideamp, & domain=G%domain%mpp_domain, timelevel=1) endif - call get_param(param_file, mod, "H2_FILE", h2_file, & + call get_param(param_file, mdl, "H2_FILE", h2_file, & "The path to the file containing the sub-grid-scale \n"//& "topographic roughness amplitude with INT_TIDE_DISSIPATION.", & fail_if_missing=.true.) filename = trim(CS%inputdir) // trim(h2_file) - call log_param(param_file, mod, "INPUTDIR/H2_FILE", filename) + call log_param(param_file, mdl, "INPUTDIR/H2_FILE", filename) call read_data(filename, 'h2', CS%h2, domain=G%domain%mpp_domain, & timelevel=1) @@ -2984,28 +2984,28 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp if (CS%Lee_wave_dissipation) then - call get_param(param_file, mod, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & + call get_param(param_file, mdl, "NIKURASHIN_TKE_INPUT_FILE",Niku_TKE_input_file, & "The path to the file containing the TKE input from lee \n"//& "wave driven mixing. Used with LEE_WAVE_DISSIPATION.", & fail_if_missing=.true.) - call get_param(param_file, mod, "NIKURASHIN_SCALE",Niku_scale, & + call get_param(param_file, mdl, "NIKURASHIN_SCALE",Niku_scale, & "A non-dimensional factor by which to scale the lee-wave \n"//& "driven TKE input. Used with LEE_WAVE_DISSIPATION.", & units="nondim", default=1.0) filename = trim(CS%inputdir) // trim(Niku_TKE_input_file) - call log_param(param_file, mod, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & + call log_param(param_file, mdl, "INPUTDIR/NIKURASHIN_TKE_INPUT_FILE", & filename) call safe_alloc_ptr(CS%TKE_Niku,is,ie,js,je); CS%TKE_Niku(:,:) = 0.0 call read_data(filename, 'TKE_input', CS%TKE_Niku, & domain=G%domain%mpp_domain, timelevel=1 ) ! ??? timelevel -aja CS%TKE_Niku(:,:) = Niku_scale * CS%TKE_Niku(:,:) - call get_param(param_file, mod, "GAMMA_NIKURASHIN",CS%Gamma_lee, & + call get_param(param_file, mdl, "GAMMA_NIKURASHIN",CS%Gamma_lee, & "The fraction of the lee wave energy that is dissipated \n"//& "locally with LEE_WAVE_DISSIPATION.", units="nondim", & default=0.3333) - call get_param(param_file, mod, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & + call get_param(param_file, mdl, "DECAY_SCALE_FACTOR_LEE",CS%Decay_scale_factor_lee, & "Scaling for the vertical decay scaleof the local \n"//& "dissipation of lee waves dissipation.", units="nondim", & default=1.0) @@ -3099,18 +3099,18 @@ subroutine set_diffusivity_init(Time, G, GV, param_file, diag, CS, diag_to_Z_CSp endif endif - call get_param(param_file, mod, "DOUBLE_DIFFUSION", CS%double_diffusion, & + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", CS%double_diffusion, & "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & default=.false.) if (CS%double_diffusion) then - call get_param(param_file, mod, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & + call get_param(param_file, mdl, "MAX_RRHO_SALT_FINGERS", CS%Max_Rrho_salt_fingers, & "Maximum density ratio for salt fingering regime.", & default=2.55, units="nondim") - call get_param(param_file, mod, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & + call get_param(param_file, mdl, "MAX_SALT_DIFF_SALT_FINGERS", CS%Max_salt_diff_salt_fingers, & "Maximum salt diffusivity for salt fingering regime.", & default=1.e-4, units="m2 s-1") - call get_param(param_file, mod, "KV_MOLECULAR", CS%Kv_molecular, & + call get_param(param_file, mdl, "KV_MOLECULAR", CS%Kv_molecular, & "Molecular viscosity for calculation of fluxes under \n"//& "double-diffusive convection.", default=1.5e-6, units="m2 s-1") ! The default molecular viscosity follows the CCSM4.0 and MOM4p1 defaults. diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 7aace7e769..98d002faaa 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -1723,21 +1723,21 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) logical :: use_kappa_shear, adiabatic, useKPP, useEPBL logical :: use_CVMix, MLE_use_PBL_MLD integer :: isd, ied, jsd, jed, nz - character(len=40) :: mod = "MOM_set_visc" ! This module's name. + character(len=40) :: mdl = "MOM_set_visc" ! This module's name. isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed ; nz = GV%ke - call get_param(param_file, mod, "ADIABATIC", adiabatic, default=.false., & + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) use_kappa_shear = .false. ; use_CVMix = .false. ; useKPP = .false. ; useEPBL = .false. if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) use_CVMix = CVMix_shear_is_used(param_file) - call get_param(param_file, mod, "USE_KPP", useKPP, & + call get_param(param_file, mdl, "USE_KPP", useKPP, & "If true, turns on the [CVmix] KPP scheme of Large et al., 1984,\n"// & "to calculate diffusivities and non-local transport in the OBL.", & default=.false., do_not_log=.true.) - call get_param(param_file, mod, "ENERGETICS_SFC_PBL", useEPBL, & + call get_param(param_file, mdl, "ENERGETICS_SFC_PBL", useEPBL, & "If true, use an implied energetics planetary boundary \n"//& "layer scheme to determine the diffusivity and viscosity \n"//& "in the surface boundary layer.", default=.false., do_not_log=.true.) @@ -1761,7 +1761,7 @@ subroutine set_visc_register_restarts(HI, GV, param_file, visc, restart_CS) endif ! visc%MLD is used to communicate the state of the (e)PBL to the rest of the model - call get_param(param_file, mod, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & + call get_param(param_file, mdl, "MLE_USE_PBL_MLD", MLE_use_PBL_MLD, & default=.false., do_not_log=.true.) if (MLE_use_PBL_MLD) then allocate(visc%MLD(isd:ied,jsd:jed)) ; visc%MLD(:,:) = 0.0 @@ -1799,7 +1799,7 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) type(OBC_segment_type), pointer :: segment ! pointer to OBC segment type ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_set_visc" ! This module's name. + character(len=40) :: mdl = "MOM_set_visc" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "set_visc_init called with an associated "// & @@ -1817,26 +1817,26 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) CS%diag => diag ! Set default, read and log parameters - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") CS%RiNo_mix = .false. use_kappa_shear = .false. ; differential_diffusion = .false. !; adiabatic = .false. ! Needed? -AJA - call get_param(param_file, mod, "BOTTOMDRAGLAW", CS%bottomdraglaw, & + call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& "may be an assumed value or it may be based on the \n"//& "actual velocity in the bottommost HBBL, depending on \n"//& "LINEAR_DRAG.", default=.true.) - call get_param(param_file, mod, "CHANNEL_DRAG", CS%Channel_drag, & + call get_param(param_file, mdl, "CHANNEL_DRAG", CS%Channel_drag, & "If true, the bottom drag is exerted directly on each \n"//& "layer proportional to the fraction of the bottom it \n"//& "overlies.", default=.false.) - call get_param(param_file, mod, "LINEAR_DRAG", CS%linear_drag, & + call get_param(param_file, mdl, "LINEAR_DRAG", CS%linear_drag, & "If LINEAR_DRAG and BOTTOMDRAGLAW are defined the drag \n"//& "law is cdrag*DRAG_BG_VEL*u.", default=.false.) - call get_param(param_file, mod, "ADIABATIC", adiabatic, default=.false., & + call get_param(param_file, mdl, "ADIABATIC", adiabatic, default=.false., & do_not_log=.true.) if (adiabatic) then - call log_param(param_file, mod, "ADIABATIC",adiabatic, & + call log_param(param_file, mdl, "ADIABATIC",adiabatic, & "There are no diapycnal mass fluxes if ADIABATIC is \n"//& "true. This assumes that KD = KDML = 0.0 and that \n"//& "there is no buoyancy forcing, but makes the model \n"//& @@ -1846,37 +1846,37 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) if (.not.adiabatic) then use_kappa_shear = kappa_shear_is_used(param_file) CS%RiNo_mix = use_kappa_shear - call get_param(param_file, mod, "DOUBLE_DIFFUSION", differential_diffusion, & + call get_param(param_file, mdl, "DOUBLE_DIFFUSION", differential_diffusion, & "If true, increase diffusivitives for temperature or salt \n"//& "based on double-diffusive paramaterization from MOM4/KPP.", & default=.false.) endif - call get_param(param_file, mod, "PRANDTL_TURB", visc%Prandtl_turb, & + call get_param(param_file, mdl, "PRANDTL_TURB", visc%Prandtl_turb, & "The turbulent Prandtl number applied to shear \n"//& "instability.", units="nondim", default=1.0) - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) - call get_param(param_file, mod, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & + call get_param(param_file, mdl, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & "If true, use a bulk Richardson number criterion to \n"//& "determine the mixed layer thickness for viscosity.", & default=.false.) if (CS%dynamic_viscous_ML) then - call get_param(param_file, mod, "BULK_RI_ML", bulk_Ri_ML_dflt, default=0.0) - call get_param(param_file, mod, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & + call get_param(param_file, mdl, "BULK_RI_ML", bulk_Ri_ML_dflt, default=0.0) + call get_param(param_file, mdl, "BULK_RI_ML_VISC", CS%bulk_Ri_ML, & "The efficiency with which mean kinetic energy released \n"//& "by mechanically forced entrainment of the mixed layer \n"//& "is converted to turbulent kinetic energy. By default, \n"//& "BULK_RI_ML_VISC = BULK_RI_ML or 0.", units="nondim", & default=bulk_Ri_ML_dflt) - call get_param(param_file, mod, "TKE_DECAY", TKE_decay_dflt, default=0.0) - call get_param(param_file, mod, "TKE_DECAY_VISC", CS%TKE_decay, & + call get_param(param_file, mdl, "TKE_DECAY", TKE_decay_dflt, default=0.0) + call get_param(param_file, mdl, "TKE_DECAY_VISC", CS%TKE_decay, & "TKE_DECAY_VISC relates the vertical rate of decay of \n"//& "the TKE available for mechanical entrainment to the \n"//& "natural Ekman depth for use in calculating the dynamic \n"//& "mixed layer viscosity. By default, \n"//& "TKE_DECAY_VISC = TKE_DECAY or 0.", units="nondim", & default=TKE_decay_dflt) - call get_param(param_file, mod, "ML_USE_OMEGA", use_omega, & + call get_param(param_file, mdl, "ML_USE_OMEGA", use_omega, & "If true, use the absolute rotation rate instead of the \n"//& "vertical component of rotation when setting the decay \n"//& "scale for turbulence.", default=.false., do_not_log=.true.) @@ -1885,78 +1885,78 @@ subroutine set_visc_init(Time, G, GV, param_file, diag, visc, CS, OBC) call MOM_error(WARNING, "ML_USE_OMEGA is depricated; use ML_OMEGA_FRAC=1.0 instead.") omega_frac_dflt = 1.0 endif - call get_param(param_file, mod, "ML_OMEGA_FRAC", CS%omega_frac, & + call get_param(param_file, mdl, "ML_OMEGA_FRAC", CS%omega_frac, & "When setting the decay scale for turbulence, use this \n"//& "fraction of the absolute rotation rate blended with the \n"//& "local value of f, as sqrt((1-of)*f^2 + of*4*omega^2).", & units="nondim", default=omega_frac_dflt) - call get_param(param_file, mod, "OMEGA", CS%omega, & + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) ! This give a minimum decay scale that is typically much less than Angstrom. CS%ustar_min = 2e-4*CS%omega*(GV%Angstrom_z + GV%H_to_m*GV%H_subroundoff) else - call get_param(param_file, mod, "OMEGA", CS%omega, & + call get_param(param_file, mdl, "OMEGA", CS%omega, & "The rotation rate of the earth.", units="s-1", & default=7.2921e-5) endif - call get_param(param_file, mod, "HBBL", CS%Hbbl, & + call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) if (CS%bottomdraglaw) then - call get_param(param_file, mod, "CDRAG", CS%cdrag, & + call get_param(param_file, mdl, "CDRAG", CS%cdrag, & "CDRAG is the drag coefficient relating the magnitude of \n"//& "the velocity field to the bottom stress. CDRAG is only \n"//& "used if BOTTOMDRAGLAW is defined.", units="nondim", & default=0.003) - call get_param(param_file, mod, "DRAG_BG_VEL", CS%drag_bg_vel, & + call get_param(param_file, mdl, "DRAG_BG_VEL", CS%drag_bg_vel, & "DRAG_BG_VEL is either the assumed bottom velocity (with \n"//& "LINEAR_DRAG) or an unresolved velocity that is \n"//& "combined with the resolved velocity to estimate the \n"//& "velocity magnitude. DRAG_BG_VEL is only used when \n"//& "BOTTOMDRAGLAW is defined.", units="m s-1", default=0.0) - call get_param(param_file, mod, "BBL_USE_EOS", CS%BBL_use_EOS, & + call get_param(param_file, mdl, "BBL_USE_EOS", CS%BBL_use_EOS, & "If true, use the equation of state in determining the \n"//& "properties of the bottom boundary layer. Otherwise use \n"//& "the layer target potential densities.", default=.false.) endif - call get_param(param_file, mod, "BBL_THICK_MIN", CS%BBL_thick_min, & + call get_param(param_file, mdl, "BBL_THICK_MIN", CS%BBL_thick_min, & "The minimum bottom boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& "near-bottom viscosity.", units="m", default=0.0) - call get_param(param_file, mod, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & + call get_param(param_file, mdl, "HTBL_SHELF_MIN", CS%Htbl_shelf_min, & "The minimum top boundary layer thickness that can be \n"//& "used with BOTTOMDRAGLAW. This might be \n"//& "Kv / (cdrag * drag_bg_vel) to give Kv as the minimum \n"//& "near-top viscosity.", units="m", default=CS%BBL_thick_min) - call get_param(param_file, mod, "HTBL_SHELF", CS%Htbl_shelf, & + call get_param(param_file, mdl, "HTBL_SHELF", CS%Htbl_shelf, & "The thickness over which near-surface velocities are \n"//& "averaged for the drag law under an ice shelf. By \n"//& "default this is the same as HBBL", units="m", default=CS%Hbbl) - call get_param(param_file, mod, "KV", Kv_background, & + call get_param(param_file, mdl, "KV", Kv_background, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) - call get_param(param_file, mod, "KV_BBL_MIN", CS%KV_BBL_min, & + call get_param(param_file, mdl, "KV_BBL_MIN", CS%KV_BBL_min, & "The minimum viscosities in the bottom boundary layer.", & units="m2 s-1", default=Kv_background) - call get_param(param_file, mod, "KV_TBL_MIN", CS%KV_TBL_min, & + call get_param(param_file, mdl, "KV_TBL_MIN", CS%KV_TBL_min, & "The minimum viscosities in the top boundary layer.", & units="m2 s-1", default=Kv_background) if (CS%Channel_drag) then - call get_param(param_file, mod, "SMAG_LAP_CONST", smag_const1, default=-1.0) + call get_param(param_file, mdl, "SMAG_LAP_CONST", smag_const1, default=-1.0) cSmag_chan_dflt = 0.15 if (smag_const1 >= 0.0) cSmag_chan_dflt = smag_const1 - call get_param(param_file, mod, "SMAG_CONST_CHANNEL", CS%c_Smag, & + call get_param(param_file, mdl, "SMAG_CONST_CHANNEL", CS%c_Smag, & "The nondimensional Laplacian Smagorinsky constant used \n"//& "in calculating the channel drag if it is enabled. The \n"//& "default is to use the same value as SMAG_LAP_CONST if \n"//& diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index 9f73bf86c3..d55be0bd95 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -162,7 +162,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & ! for this module ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_sponge" ! This module's name. + character(len=40) :: mdl = "MOM_sponge" ! This module's name. logical :: use_sponge integer :: i, j, k, col, total_sponge_cols @@ -173,8 +173,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & endif ! Set default, read and log parameters - call log_version(param_file, mod, version) - call get_param(param_file, mod, "SPONGE", use_sponge, & + call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "SPONGE", use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) @@ -238,7 +238,7 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, & total_sponge_cols = CS%num_col call sum_across_PEs(total_sponge_cols) - call log_param(param_file, mod, "!Total sponge columns", total_sponge_cols, & + call log_param(param_file, mdl, "!Total sponge columns", total_sponge_cols, & "The total number of columns where sponges are applied.") end subroutine initialize_sponge diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 0cfb4bd390..15e3f51dc9 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -1474,7 +1474,7 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, nz ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_vert_friction" ! This module's name. + character(len=40) :: mdl = "MOM_vert_friction" ! This module's name. character(len=40) :: thickness_units = "meters or kg m-2" if (associated(CS)) then @@ -1490,106 +1490,106 @@ subroutine vertvisc_init(MIS, Time, G, GV, param_file, diag, ADp, dirs, & CS%diag => diag ; CS%ntrunc => ntrunc ; ntrunc = 0 ! Default, read and log parameters - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "BOTTOMDRAGLAW", CS%bottomdraglaw, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "BOTTOMDRAGLAW", CS%bottomdraglaw, & "If true, the bottom stress is calculated with a drag \n"//& "law of the form c_drag*|u|*u. The velocity magnitude \n"//& "may be an assumed value or it may be based on the \n"//& "actual velocity in the bottommost HBBL, depending on \n"//& "LINEAR_DRAG.", default=.true.) - call get_param(param_file, mod, "CHANNEL_DRAG", CS%Channel_drag, & + call get_param(param_file, mdl, "CHANNEL_DRAG", CS%Channel_drag, & "If true, the bottom drag is exerted directly on each \n"//& "layer proportional to the fraction of the bottom it \n"//& "overlies.", default=.false.) - call get_param(param_file, mod, "DIRECT_STRESS", CS%direct_stress, & + call get_param(param_file, mdl, "DIRECT_STRESS", CS%direct_stress, & "If true, the wind stress is distributed over the \n"//& "topmost HMIX_STRESS of fluid (like in HYCOM), and KVML \n"//& "may be set to a very small value.", default=.false.) - call get_param(param_file, mod, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & + call get_param(param_file, mdl, "DYNAMIC_VISCOUS_ML", CS%dynamic_viscous_ML, & "If true, use a bulk Richardson number criterion to \n"//& "determine the mixed layer thickness for viscosity.", & default=.false.) - call get_param(param_file, mod, "U_TRUNC_FILE", CS%u_trunc_file, & + call get_param(param_file, mdl, "U_TRUNC_FILE", CS%u_trunc_file, & "The absolute path to a file into which the accelerations \n"//& "leading to zonal velocity truncations are written. \n"//& "Undefine this for efficiency if this diagnostic is not \n"//& "needed.", default=" ") - call get_param(param_file, mod, "V_TRUNC_FILE", CS%v_trunc_file, & + call get_param(param_file, mdl, "V_TRUNC_FILE", CS%v_trunc_file, & "The absolute path to a file into which the accelerations \n"//& "leading to meridional velocity truncations are written. \n"//& "Undefine this for efficiency if this diagnostic is not \n"//& "needed.", default=" ") - call get_param(param_file, mod, "HARMONIC_VISC", CS%harmonic_visc, & + call get_param(param_file, mdl, "HARMONIC_VISC", CS%harmonic_visc, & "If true, use the harmonic mean thicknesses for \n"//& "calculating the vertical viscosity.", default=.false.) - call get_param(param_file, mod, "HARMONIC_BL_SCALE", CS%harm_BL_val, & + call get_param(param_file, mdl, "HARMONIC_BL_SCALE", CS%harm_BL_val, & "A scale to determine when water is in the boundary \n"//& "layers based solely on harmonic mean thicknesses for \n"//& "the purpose of determining the extent to which the \n"//& "thicknesses used in the viscosities are upwinded.", & default=0.0, units="nondim") - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) if (GV%nkml < 1) & - call get_param(param_file, mod, "HMIX_FIXED", CS%Hmix, & + call get_param(param_file, mdl, "HMIX_FIXED", CS%Hmix, & "The prescribed depth over which the near-surface \n"//& "viscosity and diffusivity are elevated when the bulk \n"//& "mixed layer is not used.", units="m", fail_if_missing=.true.) if (CS%direct_stress) then if (GV%nkml < 1) then - call get_param(param_file, mod, "HMIX_STRESS", CS%Hmix_stress, & + call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& "DIRECT_STRESS is true.", units="m", default=CS%Hmix) else - call get_param(param_file, mod, "HMIX_STRESS", CS%Hmix_stress, & + call get_param(param_file, mdl, "HMIX_STRESS", CS%Hmix_stress, & "The depth over which the wind stress is applied if \n"//& "DIRECT_STRESS is true.", units="m", fail_if_missing=.true.) endif if (CS%Hmix_stress <= 0.0) call MOM_error(FATAL, "vertvisc_init: " // & "HMIX_STRESS must be set to a positive value if DIRECT_STRESS is true.") endif - call get_param(param_file, mod, "KV", CS%Kv, & + call get_param(param_file, mdl, "KV", CS%Kv, & "The background kinematic viscosity in the interior. \n"//& "The molecular value, ~1e-6 m2 s-1, may be used.", & units="m2 s-1", fail_if_missing=.true.) ! CS%Kvml = CS%Kv ; CS%Kvbbl = CS%Kv ! Needed? -AJA - if (GV%nkml < 1) call get_param(param_file, mod, "KVML", CS%Kvml, & + if (GV%nkml < 1) call get_param(param_file, mdl, "KVML", CS%Kvml, & "The kinematic viscosity in the mixed layer. A typical \n"//& "value is ~1e-2 m2 s-1. KVML is not used if \n"//& "BULKMIXEDLAYER is true. The default is set by KV.", & units="m2 s-1", default=CS%Kv) - if (.not.CS%bottomdraglaw) call get_param(param_file, mod, "KVBBL", CS%Kvbbl, & + if (.not.CS%bottomdraglaw) call get_param(param_file, mdl, "KVBBL", CS%Kvbbl, & "The kinematic viscosity in the benthic boundary layer. \n"//& "A typical value is ~1e-2 m2 s-1. KVBBL is not used if \n"//& "BOTTOMDRAGLAW is true. The default is set by KV.", & units="m2 s-1", default=CS%Kv) - call get_param(param_file, mod, "HBBL", CS%Hbbl, & + call get_param(param_file, mdl, "HBBL", CS%Hbbl, & "The thickness of a bottom boundary layer with a \n"//& "viscosity of KVBBL if BOTTOMDRAGLAW is not defined, or \n"//& "the thickness over which near-bottom velocities are \n"//& "averaged for the drag law if BOTTOMDRAGLAW is defined \n"//& "but LINEAR_DRAG is not.", units="m", fail_if_missing=.true.) - call get_param(param_file, mod, "MAXVEL", CS%maxvel, & + call get_param(param_file, mdl, "MAXVEL", CS%maxvel, & "The maximum velocity allowed before the velocity \n"//& "components are truncated.", units="m s-1", default=3.0e8) - call get_param(param_file, mod, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & + call get_param(param_file, mdl, "CFL_BASED_TRUNCATIONS", CS%CFL_based_trunc, & "If true, base truncations on the CFL number, and not an \n"//& "absolute speed.", default=.true.) - call get_param(param_file, mod, "CFL_TRUNCATE", CS%CFL_trunc, & + call get_param(param_file, mdl, "CFL_TRUNCATE", CS%CFL_trunc, & "The value of the CFL number that will cause velocity \n"//& "components to be truncated; instability can occur past 0.5.", & units="nondim", default=0.5) - call get_param(param_file, mod, "CFL_REPORT", CS%CFL_report, & + call get_param(param_file, mdl, "CFL_REPORT", CS%CFL_report, & "The value of the CFL number that causes accelerations \n"//& "to be reported; the default is CFL_TRUNCATE.", & units="nondim", default=CS%CFL_trunc) - call get_param(param_file, mod, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & + call get_param(param_file, mdl, "CFL_TRUNCATE_RAMP_TIME", CS%truncRampTime, & "The time over which the CFL trunction value is ramped\n"//& "up at the beginning of the run.", & units="s", default=0.) CS%CFL_truncE = CS%CFL_trunc - call get_param(param_file, mod, "CFL_TRUNCATE_START", CS%CFL_truncS, & + call get_param(param_file, mdl, "CFL_TRUNCATE_START", CS%CFL_truncS, & "The start value of the truncation CFL number used when\n"//& "ramping up CFL_TRUNC.", & units="nondim", default=0.) diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index ca01e3ecc5..ae2e374800 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -142,7 +142,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) character(len=80) :: name, longname ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "DOME_tracer" ! This module's name. + character(len=40) :: mdl = "DOME_tracer" ! This module's name. character(len=200) :: inputdir real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_DOME_tracer @@ -157,19 +157,19 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DOME_TRACER_IC_FILE", CS%tracer_IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DOME_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& "conditions for the DOME tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) CS%tracer_IC_file = trim(inputdir)//trim(CS%tracer_IC_file) - call log_param(param_file, mod, "INPUTDIR/DOME_TRACER_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/DOME_TRACER_IC_FILE", & CS%tracer_IC_file) endif - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) @@ -183,7 +183,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif write(longname,'("Concentration of DOME Tracer ",I2.2)') m - CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 4c2569b675..b4196f73d6 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -101,7 +101,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & character(len=80) :: name, longname ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "ISOMIP_tracer" ! This module's name. + character(len=40) :: mdl = "ISOMIP_tracer" ! This module's name. character(len=200) :: inputdir real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_ISOMIP_tracer @@ -116,19 +116,19 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ISOMIP_TRACER_IC_FILE", CS%tracer_IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ISOMIP_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& "conditions for the ISOMIP tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) CS%tracer_IC_file = trim(inputdir)//trim(CS%tracer_IC_file) - call log_param(param_file, mod, "INPUTDIR/ISOMIP_TRACER_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/ISOMIP_TRACER_IC_FILE", & CS%tracer_IC_file) endif - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) @@ -142,7 +142,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, & if (m < 10) then ; write(name,'("tr_D",I1.1)') m else ; write(name,'("tr_D",I2.2)') m ; endif write(longname,'("Concentration of ISOMIP Tracer ",I2.2)') m - CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index f7f2b0d71d..9dcf5db7db 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -158,12 +158,14 @@ module MOM_OCMIP2_CFC contains function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(OCMIP2_CFC_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters. + type(OCMIP2_CFC_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module. + type(tracer_registry_type), & + pointer :: tr_Reg !< A pointer to the tracer registry. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control structure. ! This subroutine is used to register tracer fields and subroutines ! to be used with MOM. ! Arguments: HI - A horizontal index type structure. @@ -176,7 +178,7 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_OCMIP2_CFC" ! This module's name. + character(len=40) :: mdl = "MOM_OCMIP2_CFC" ! This module's name. character(len=200) :: inputdir ! The directory where NetCDF input files are. ! These can be overridden later in via the field manager? character(len=128) :: default_ice_restart_file = 'ice_ocmip2_cfc.res.nc' @@ -221,24 +223,24 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "CFC_IC_FILE", CS%IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "CFC_IC_FILE", CS%IC_file, & "The file in which the CFC initial values can be \n"//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then ! Add the directory if CS%IC_file is not already a complete path. - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%IC_file = trim(slasher(inputdir))//trim(CS%IC_file) - call log_param(param_file, mod, "INPUTDIR/CFC_IC_FILE", CS%IC_file) + call log_param(param_file, mdl, "INPUTDIR/CFC_IC_FILE", CS%IC_file) endif - call get_param(param_file, mod, "CFC_IC_FILE_IS_Z", CS%Z_IC_file, & + call get_param(param_file, mdl, "CFC_IC_FILE_IS_Z", CS%Z_IC_file, & "If true, CFC_IC_FILE is in depth space, not layer space", & default=.false.) - call get_param(param_file, mod, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & + call get_param(param_file, mdl, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & "If true, the tracers are masked out in massless layer. \n"//& "This can be a problem with time-averages.", default=.false.) - call get_param(param_file, mod, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & + call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code \n"//& "if they are not found in the restart files. Otherwise \n"//& "it is a fatal error if tracers are not found in the \n"//& @@ -247,8 +249,8 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) ! The following vardesc types contain a package of metadata about each tracer, ! including, the name; units; longname; and grid information. CS%CFC11_name = "CFC11" ; CS%CFC12_name = "CFC12" - CS%CFC11_desc = var_desc(CS%CFC11_name,"mol m-3","CFC-11 Concentration", caller=mod) - CS%CFC12_desc = var_desc(CS%CFC12_name,"mol m-3","CFC-12 Concentration", caller=mod) + CS%CFC11_desc = var_desc(CS%CFC11_name,"mol m-3","CFC-11 Concentration", caller=mdl) + CS%CFC12_desc = var_desc(CS%CFC12_name,"mol m-3","CFC-12 Concentration", caller=mdl) allocate(CS%CFC11(isd:ied,jsd:jed,nz)) ; CS%CFC11(:,:,:) = 0.0 allocate(CS%CFC12(isd:ied,jsd:jed,nz)) ; CS%CFC12(:,:,:) = 0.0 @@ -281,29 +283,29 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) !----------------------------------------------------------------------- a11_dflt(:) = (/ 3501.8, -210.31, 6.1851, -0.07513 /) a12_dflt(:) = (/ 3845.4, -228.95, 6.1908, -0.06743 /) - call get_param(param_file, mod, "CFC11_A1", CS%a1_11, & + call get_param(param_file, mdl, "CFC11_A1", CS%a1_11, & "A coefficient in the Schmidt number of CFC11.", & units="nondim", default=a11_dflt(1)) - call get_param(param_file, mod, "CFC11_A2", CS%a2_11, & + call get_param(param_file, mdl, "CFC11_A2", CS%a2_11, & "A coefficient in the Schmidt number of CFC11.", & units="degC-1", default=a11_dflt(2)) - call get_param(param_file, mod, "CFC11_A3", CS%a3_11, & + call get_param(param_file, mdl, "CFC11_A3", CS%a3_11, & "A coefficient in the Schmidt number of CFC11.", & units="degC-2", default=a11_dflt(3)) - call get_param(param_file, mod, "CFC11_A4", CS%a4_11, & + call get_param(param_file, mdl, "CFC11_A4", CS%a4_11, & "A coefficient in the Schmidt number of CFC11.", & units="degC-3", default=a11_dflt(4)) - call get_param(param_file, mod, "CFC12_A1", CS%a1_12, & + call get_param(param_file, mdl, "CFC12_A1", CS%a1_12, & "A coefficient in the Schmidt number of CFC12.", & units="nondim", default=a12_dflt(1)) - call get_param(param_file, mod, "CFC12_A2", CS%a2_12, & + call get_param(param_file, mdl, "CFC12_A2", CS%a2_12, & "A coefficient in the Schmidt number of CFC12.", & units="degC-1", default=a12_dflt(2)) - call get_param(param_file, mod, "CFC12_A3", CS%a3_12, & + call get_param(param_file, mdl, "CFC12_A3", CS%a3_12, & "A coefficient in the Schmidt number of CFC12.", & units="degC-2", default=a12_dflt(3)) - call get_param(param_file, mod, "CFC12_A4", CS%a4_12, & + call get_param(param_file, mdl, "CFC12_A4", CS%a4_12, & "A coefficient in the Schmidt number of CFC12.", & units="degC-3", default=a12_dflt(4)) @@ -316,47 +318,47 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) d12_dflt(:) = (/ -218.0971, 298.9702, 113.8049, -1.39165 /) e12_dflt(:) = (/ -0.143566, 0.091015, -0.0153924 /) - call get_param(param_file, mod, "CFC11_D1", CS%d1_11, & + call get_param(param_file, mdl, "CFC11_D1", CS%d1_11, & "A coefficient in the solubility of CFC11.", & units="none", default=d11_dflt(1)) - call get_param(param_file, mod, "CFC11_D2", CS%d2_11, & + call get_param(param_file, mdl, "CFC11_D2", CS%d2_11, & "A coefficient in the solubility of CFC11.", & units="hK", default=d11_dflt(2)) - call get_param(param_file, mod, "CFC11_D3", CS%d3_11, & + call get_param(param_file, mdl, "CFC11_D3", CS%d3_11, & "A coefficient in the solubility of CFC11.", & units="none", default=d11_dflt(3)) - call get_param(param_file, mod, "CFC11_D4", CS%d4_11, & + call get_param(param_file, mdl, "CFC11_D4", CS%d4_11, & "A coefficient in the solubility of CFC11.", & units="hK-2", default=d11_dflt(4)) - call get_param(param_file, mod, "CFC11_E1", CS%e1_11, & + call get_param(param_file, mdl, "CFC11_E1", CS%e1_11, & "A coefficient in the solubility of CFC11.", & units="PSU-1", default=e11_dflt(1)) - call get_param(param_file, mod, "CFC11_E2", CS%e2_11, & + call get_param(param_file, mdl, "CFC11_E2", CS%e2_11, & "A coefficient in the solubility of CFC11.", & units="PSU-1 hK-1", default=e11_dflt(2)) - call get_param(param_file, mod, "CFC11_E3", CS%e3_11, & + call get_param(param_file, mdl, "CFC11_E3", CS%e3_11, & "A coefficient in the solubility of CFC11.", & units="PSU-1 hK-2", default=e11_dflt(3)) - call get_param(param_file, mod, "CFC12_D1", CS%d1_12, & + call get_param(param_file, mdl, "CFC12_D1", CS%d1_12, & "A coefficient in the solubility of CFC12.", & units="none", default=d12_dflt(1)) - call get_param(param_file, mod, "CFC12_D2", CS%d2_12, & + call get_param(param_file, mdl, "CFC12_D2", CS%d2_12, & "A coefficient in the solubility of CFC12.", & units="hK", default=d12_dflt(2)) - call get_param(param_file, mod, "CFC12_D3", CS%d3_12, & + call get_param(param_file, mdl, "CFC12_D3", CS%d3_12, & "A coefficient in the solubility of CFC12.", & units="none", default=d12_dflt(3)) - call get_param(param_file, mod, "CFC12_D4", CS%d4_12, & + call get_param(param_file, mdl, "CFC12_D4", CS%d4_12, & "A coefficient in the solubility of CFC12.", & units="hK-2", default=d12_dflt(4)) - call get_param(param_file, mod, "CFC12_E1", CS%e1_12, & + call get_param(param_file, mdl, "CFC12_E1", CS%e1_12, & "A coefficient in the solubility of CFC12.", & units="PSU-1", default=e12_dflt(1)) - call get_param(param_file, mod, "CFC12_E2", CS%e2_12, & + call get_param(param_file, mdl, "CFC12_E2", CS%e2_12, & "A coefficient in the solubility of CFC12.", & units="PSU-1 hK-1", default=e12_dflt(2)) - call get_param(param_file, mod, "CFC12_E3", CS%e3_12, & + call get_param(param_file, mdl, "CFC12_E3", CS%e3_12, & "A coefficient in the solubility of CFC12.", & units="PSU-1 hK-2", default=e12_dflt(3)) @@ -365,19 +367,30 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) register_OCMIP2_CFC = .true. end function register_OCMIP2_CFC - +!>This subroutine initializes the NTR tracer fields in tr(:,:,:,:) +!! and it sets up the tracer output. subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & sponge_CSp, diag_to_Z_CSp) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day - 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 !< Layer thicknesses, in H (usually m or kg m-2) - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(OCMIP2_CFC_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp + logical, intent(in) :: restart !< .true. if the fields have already been + !! read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + 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 !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to regulate + !! diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition type + !! specifies whether, where, and what + !! open boundary conditions are used. + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. + type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control structure for + !! the sponges, if they are in use. + !! Otherwise this may be unassociated. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control structure + !! for diagnostics in depth space. ! This subroutine initializes the NTR tracer fields in tr(:,:,:,:) ! and it sets up the tracer output. @@ -483,7 +496,7 @@ subroutine initialize_OCMIP2_CFC(restart, day, G, GV, h, diag, OBC, CS, & enddo end subroutine initialize_OCMIP2_CFC - +!>This subroutine initializes a tracer array. subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) @@ -525,16 +538,37 @@ subroutine init_tracer_CFC(h, tr, name, land_val, IC_val, G, CS) end subroutine init_tracer_CFC +!> This subroutine applies diapycnal diffusion and any other column +! tracer physics or chemistry to the tracers from this file. +! CFCs are relatively simple, as they are passive tracers. with only a surface +! flux as a source. subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS, & evap_CFL_limit, minimum_forcing_depth) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, intent(in) :: dt !< The amount of time covered by this call, in s - type(OCMIP2_CFC_CS), pointer :: CS - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: 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, + !! in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: h_new !< Layer thickness after entrainment, + !! in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: ea !< an array to which the amount of fluid + !! entrained from the layer above during + !! this call will be added, in m or kg m-2. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(in) :: eb !< an array to which the amount of fluid + !! entrained from the layer below during + !! this call will be added, in m or kg m-2. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + real, intent(in) :: dt !< The amount of time covered by this + !! call, in s + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. + real, optional,intent(in) :: evap_CFL_limit + real, optional,intent(in) :: minimum_forcing_depth ! This subroutine applies diapycnal diffusion and any other column ! tracer physics or chemistry to the tracers from this file. ! CFCs are relatively simple, as they are passive tracers. with only a surface @@ -633,16 +667,25 @@ subroutine OCMIP2_CFC_column_physics(h_old, h_new, ea, eb, fluxes, dt, G, GV, CS end subroutine OCMIP2_CFC_column_physics +!> This function calculates the mass-weighted integral of all tracer stocks, +!! returning the number of stocks it has calculated. If the stock_index +!! is present, only the stock corresponding to that coded index is returned. function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) - 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 !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stocks - type(OCMIP2_CFC_CS), pointer :: CS - character(len=*), dimension(:), intent(out) :: names - character(len=*), dimension(:), intent(out) :: units - integer, optional, intent(in) :: stock_index - integer :: OCMIP2_CFC_stock + 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 !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(:), intent(out) :: stocks !< the mass-weighted integrated amount + !! of each tracer, in kg times + !! concentration units. + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned by a + !! previous call to register_OCMIP2_CFC. + character(len=*), dimension(:), intent(out) :: names !< The names of the stocks calculated. + character(len=*), dimension(:), intent(out) :: units !< The units of the stocks calculated. + integer, optional, intent(in) :: stock_index !< The coded index of a specific + !! stock being sought. + integer :: OCMIP2_CFC_stock ! This function calculates the mass-weighted integral of all tracer stocks, ! returning the number of stocks it has calculated. If the stock_index ! is present, only the stock corresponding to that coded index is returned. @@ -691,10 +734,13 @@ function OCMIP2_CFC_stock(h, stocks, G, GV, CS, names, units, stock_index) end function OCMIP2_CFC_stock subroutine OCMIP2_CFC_surface_state(state, h, G, CS) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(surface), intent(inout) :: state - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(OCMIP2_CFC_CS), pointer :: CS + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(OCMIP2_CFC_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! register_OCMIP2_CFC. ! This subroutine sets up the fields that the coupler needs to calculate the ! CFC fluxes between the ocean and atmosphere. ! Arguments: state - A structure containing fields that describe the diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 7fb4abd307..0093ebb953 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -54,7 +54,7 @@ module MOM_neutral_diffusion ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mod = "MOM_neutral_diffusion" ! module name +character(len=40) :: mdl = "MOM_neutral_diffusion" ! module name logical, parameter :: debug_this_module = .false. @@ -77,9 +77,9 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, CS) endif ! Log this module and master switch for turning it on/off - call log_version(param_file, mod, version, & + call log_version(param_file, mdl, version, & "This module implements neutral diffusion of tracers") - call get_param(param_file, mod, "USE_NEUTRAL_DIFFUSION", neutral_diffusion_init, & + call get_param(param_file, mdl, "USE_NEUTRAL_DIFFUSION", neutral_diffusion_init, & "If true, enables the neutral diffusion module.", & default=.false.) @@ -93,7 +93,7 @@ logical function neutral_diffusion_init(Time, G, param_file, diag, CS) ! Read all relevant parameters and write them to the model log. ! call openParameterBlock(param_file,'NEUTRAL_DIFF') -! call get_param(param_file, mod, "KHTR", CS%KhTr, & +! call get_param(param_file, mdl, "KHTR", CS%KhTr, & ! "The background along-isopycnal tracer diffusivity.", & ! units="m2 s-1", default=0.0) ! call closeParameterBlock(param_file) diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 4cf1e4b7f9..dd7fa02b0d 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -1,12 +1,17 @@ -!> Contains routines related to offline transport of tracers +!> Contains routines related to offline transport of tracers. These routines are likely to be called from +!> the MOM_offline_main module module MOM_offline_aux -! This file is part of MOM6. See LICENSE.md for the license. +! This file is part of MOM6. See LICENSE.md for the license. +use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST use data_override_mod, only : data_override_init, data_override use MOM_time_manager, only : time_type, operator(-) +use MOM_debugging, only : check_column_integrals use MOM_domains, only : pass_var, pass_vector, To_All +use MOM_diag_vkernels, only : reintegrate_column use MOM_error_handler, only : callTree_enter, callTree_leave, MOM_error, FATAL, WARNING, is_root_pe use MOM_grid, only : ocean_grid_type +use MOM_io, only : read_data use MOM_verticalGrid, only : verticalGrid_type use MOM_file_parser, only : get_param, log_version, param_file_type use astronomy_mod, only : orbital_time, diurnal_solar, daily_mean_solar @@ -18,6 +23,8 @@ module MOM_offline_aux implicit none +public update_offline_from_files +public update_offline_from_arrays public update_h_horizontal_flux public update_h_vertical_flux public limit_mass_flux_3d @@ -25,6 +32,7 @@ module MOM_offline_aux public distribute_residual_vh_barotropic public distribute_residual_uh_upwards public distribute_residual_vh_upwards +public next_modulo_time public offline_add_diurnal_sw #include "MOM_memory.h" @@ -35,8 +43,8 @@ module MOM_offline_aux !> This updates thickness based on the convergence of horizontal mass fluxes !! NOTE: Only used in non-ALE mode subroutine update_h_horizontal_flux(G, GV, uhtr, vhtr, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(in) :: uhtr real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(in) :: vhtr real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre @@ -69,8 +77,8 @@ end subroutine update_h_horizontal_flux !> Updates layer thicknesses due to vertical mass transports !! NOTE: Only used in non-ALE configuration subroutine update_h_vertical_flux(G, GV, ea, eb, h_pre, h_new) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre @@ -114,21 +122,21 @@ end subroutine update_h_vertical_flux !> This routine limits the mass fluxes so that the a layer cannot be completely depleted. !! NOTE: Only used in non-ALE mode -subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure +subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: ea real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(inout) :: eb real, dimension(SZI_(G),SZJ_(G),SZK_(G)) , intent(in) :: h_pre - real, intent(in) :: max_off_cfl ! Local variables integer :: i, j, k, m, is, ie, js, je, nz - real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux - real :: pos_flux, hvol, h_neglect, scale_factor + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: top_flux, bottom_flux + real :: pos_flux, hvol, h_neglect, scale_factor, max_off_cfl + max_off_cfl =0.5 ! In this subroutine, fluxes out of the box are scaled away if they deplete ! the layer, note that we define the positive direction as flux out of the box. @@ -180,24 +188,24 @@ subroutine limit_mass_flux_3d(G, GV, uh, vh, ea, eb, h_pre, max_off_cfl) if (k>1 .and. k0.0) then + if (top_flux(i,j,k)>0.0) then ea(i,j,k) = ea(i,j,k)*scale_factor eb(i,j,k-1) = eb(i,j,k-1)*scale_factor endif - if(bottom_flux(i,j,k)>0.0) then + if (bottom_flux(i,j,k)>0.0) then eb(i,j,k) = eb(i,j,k)*scale_factor ea(i,j,k+1) = ea(i,j,k+1)*scale_factor endif ! Scale top layer elseif (k==1) then - if(top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor - if(bottom_flux(i,j,k)>0.0) then + if (top_flux(i,j,k)>0.0) ea(i,j,k) = ea(i,j,k)*scale_factor + if (bottom_flux(i,j,k)>0.0) then eb(i,j,k) = eb(i,j,k)*scale_factor ea(i,j,k+1) = ea(i,j,k+1)*scale_factor endif ! Scale bottom layer elseif (k==nz) then - if(top_flux(i,j,k)>0.0) then + if (top_flux(i,j,k)>0.0) then ea(i,j,k) = ea(i,j,k)*scale_factor eb(i,j,k-1) = eb(i,j,k-1)*scale_factor endif @@ -209,10 +217,10 @@ end subroutine limit_mass_flux_3d !> In the case where offline advection has failed to converge, redistribute the u-flux !! into remainder of the water column as a barotropic equivalent -subroutine distribute_residual_uh_barotropic(G, GV, h, uh) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) +subroutine distribute_residual_uh_barotropic(G, GV, hvol, uh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZIB_(G),SZK_(G)) :: uh2d @@ -234,28 +242,27 @@ subroutine distribute_residual_uh_barotropic(G, GV, h, uh) uh2d_sum(I) = uh2d_sum(I) + uh2d(I,k) enddo ; enddo - ! Copy over h to a working array and calculate column height + ! Copy over h to a working array and calculate total column volume h2d_sum(:) = 0.0 - do k=1,nz ; do i=is-2,ie+1 - h2d(i,k) = h(i,j,k)*G%areaT(i,j) - if(h(i,j,k)>GV%Angstrom) then + do k=1,nz ; do i=is-1,ie+1 + h2d(i,k) = hvol(i,j,k) + if (hvol(i,j,k)>0.) then h2d_sum(i) = h2d_sum(i) + h2d(i,k) else - h2d(i,k) = 0.0 + h2d(i,k) = GV%H_subroundoff endif enddo; enddo; - ! Distribute flux. Note min/max is intended to make sure that the mass transport ! does not deplete a cell do i=is-1,ie - if( uh2d_sum(I)>0.0 ) then + if ( uh2d_sum(I)>0.0 ) then do k=1,nz - uh2d(I,k) = min(uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)),h2d(i,k)) + uh2d(I,k) = uh2d_sum(I)*(h2d(i,k)/h2d_sum(i)) enddo elseif (uh2d_sum(I)<0.0) then do k=1,nz - uh2d(I,k) = max(uh2d_sum(I)*(h2d(i+1,k)/h2d_sum(i+1)),-h2d(i+1,k)) + uh2d(I,k) = uh2d_sum(I)*(h2d(i+1,k)/h2d_sum(i+1)) enddo else do k=1,nz @@ -264,16 +271,12 @@ subroutine distribute_residual_uh_barotropic(G, GV, h, uh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - uh_neglect = nz*GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) - if( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & + uh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i+1,j)) + if ( abs(sum(uh2d(I,:))-uh2d_sum(I)) > uh_neglect) & call MOM_error(WARNING,"Column integral of uh does not match after "//& "barotropic redistribution") enddo - ! Update layer thicknesses at the end - do k=1,nz ; do i=is,ie - h(i,j,k) = h(i,j,k) + (uh2d(I-1,k) - uh2d(I,k))/G%areaT(i,j) - enddo ; enddo do k=1,nz ; do i=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo @@ -282,10 +285,10 @@ subroutine distribute_residual_uh_barotropic(G, GV, h, uh) end subroutine distribute_residual_uh_barotropic !> Redistribute the v-flux as a barotropic equivalent -subroutine distribute_residual_vh_barotropic(G, GV, h, vh) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) +subroutine distribute_residual_vh_barotropic(G, GV, hvol, vh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh real, dimension(SZJB_(G),SZK_(G)) :: vh2d @@ -309,27 +312,24 @@ subroutine distribute_residual_vh_barotropic(G, GV, h, vh) ! Copy over h to a working array and calculate column volume h2d_sum(:) = 0.0 - do k=1,nz ; do j=js-2,je+1 - h2d(j,k) = h(i,j,k)*G%areaT(i,j) - if(h(i,j,k)>GV%Angstrom) then + do k=1,nz ; do j=js-1,je+1 + h2d(j,k) = hvol(i,j,k) + if (hvol(i,j,k)>0.) then h2d_sum(j) = h2d_sum(j) + h2d(j,k) else - h2d(j,k) = 0.0 + h2d(j,k) = GV%H_subroundoff endif enddo; enddo; - - ! Distribute flux. Note min/max is intended to make sure that the mass transport - ! does not deplete a cell. If this limit is hit for some reason, tracer will - ! not be conserved + ! Distribute flux evenly throughout a column do j=js-1,je - if( vh2d_sum(J)>0.0 ) then + if ( vh2d_sum(J)>0.0 ) then do k=1,nz - vh2d(J,k) = min(vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)),0.5*h2d(j,k)) + vh2d(J,k) = vh2d_sum(J)*(h2d(j,k)/h2d_sum(j)) enddo elseif (vh2d_sum(J)<0.0) then do k=1,nz - vh2d(J,k) = max(vh2d_sum(J)*(h2d(j+1,k)/h2d_sum(j+1)),-0.5*h2d(j+1,k)) + vh2d(J,k) = vh2d_sum(J)*(h2d(j+1,k)/h2d_sum(j+1)) enddo else do k=1,nz @@ -338,18 +338,14 @@ subroutine distribute_residual_vh_barotropic(G, GV, h, vh) endif ! Calculate and check that column integrated transports match the original to ! within the tolerance limit - vh_neglect = nz*GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) - if( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) & + vh_neglect = GV%Angstrom*min(G%areaT(i,j),G%areaT(i,j+1)) + if ( abs(sum(vh2d(J,:))-vh2d_sum(J)) > vh_neglect) then call MOM_error(WARNING,"Column integral of vh does not match after "//& "barotropic redistribution") + endif enddo - ! Update layer thicknesses at the end. - ! This may not be needed since the limits on the flux are half of the original thickness - do k=1,nz ; do j=js,je - h(i,j,k) = h(i,j,k) + (vh2d(J-1,k) - vh2d(J,k))/G%areaT(i,j) - enddo ; enddo do k=1,nz ; do j=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo @@ -359,86 +355,90 @@ end subroutine distribute_residual_vh_barotropic !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above -subroutine distribute_residual_uh_upwards(G, GV, h, uh) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) +subroutine distribute_residual_uh_upwards(G, GV, hvol, uh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uh real, dimension(SZIB_(G),SZK_(G)) :: uh2d real, dimension(SZI_(G),SZK_(G)) :: h2d - real :: uh_neglect, uh_remain, uh_LB, uh_UB, uh_add + real :: uh_neglect, uh_remain, uh_add, uh_sum, uh_col, uh_max real :: hup, hdown, hlos, min_h integer :: i, j, k, m, is, ie, js, je, nz, k_rev ! Set index-related variables for fields on T-grid is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke - min_h = 0.1*GV%Angstrom + min_h = GV%Angstrom*0.1 - do j=js-1,je + do j=js,je ! Copy over uh and cell volume to working arrays - do k=1,nz ; do i=is-1,ie + do k=1,nz ; do i=is-2,ie+1 uh2d(I,k) = uh(I,j,k) enddo ; enddo - do k=1,nz ; do i=is-2,ie+1 + do k=1,nz ; do i=is-1,ie+1 ! Subtract just a little bit of thickness to avoid roundoff errors - h2d(i,k) = max(h(i,j,k)*G%areaT(i,j)-min_h*G%areaT(i,j),min_h*G%areaT(i,j)) + h2d(i,k) = hvol(i,j,k)-min_h*G%areaT(i,j) enddo ; enddo do i=is-1,ie + uh_col = SUM(uh2d(I,:)) ! Store original column-integrated transport do k=1,nz uh_remain = uh2d(I,k) - uh_neglect = GV%H_subroundoff*min(G%areaT(i,j),G%areaT(i+1,j)) - if(uh_remain<-uh_neglect) then - ! Set the mass flux to zero. This will be refilled in the first iteration - uh2d(I,k) = 0.0 - do k_rev=k,1,-1 - ! This lower bound only allows half of the layer to be depleted - uh_LB = -0.5*h2d(i+1,k_rev) - ! You can either add the difference between the lower bound and the - ! current uh, or the remaining mass transport to be distributed. - ! The max is there because it represents the minimum of these two with respect - ! to magnitude. The minimum is to guard against the case where uh2d>uh_LB - ! not quite the same potentially because of roundoff error - uh_add = min(max(uh_LB-uh2d(I,k_rev), uh_remain),0.0) - uh_remain = uh_remain - uh_add - uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add - if(uh_remain>-uh_neglect) exit - enddo - elseif (uh_remain>uh_neglect) then - ! Set the amount in the layer with remaining fluxes to zero. This will be reset - ! in the first iteration of the redistribution loop - uh2d(I,k) = 0.0 - ! Loop to distribute remaining flux in layers above - do k_rev=k,1,-1 - ! This lower bound only allows half of the layer to be depleted - uh_UB = 0.5*h2d(i,k_rev) - uh_add = max(min(uh_UB-uh2d(I,k_rev), uh_remain), 0.0) - uh_remain = uh_remain - uh_add - uh2d(I,k_rev) = uh2d(I,k_rev) + uh_add - if(uh_remain0.0) then + do k_rev = k,1,-1 + uh_sum = uh_remain + uh2d(I,k_rev) + if (uh_sum<0.0) then ! Transport to the left + hup = h2d(i+1,k_rev) + hlos = max(0.0,uh2d(I+1,k_rev)) + if ((((hup - hlos) + uh_sum) < 0.0) .and. & + ((0.5*hup + uh_sum) < 0.0)) then + uh2d(I,k_rev) = min(-0.5*hup,-hup+hlos,0.0) + uh_remain = uh_sum - uh2d(I,k_rev) + else + uh2d(I,k_rev) = uh_sum + uh_remain = 0.0 + exit + endif + else ! Transport to the right + hup = h2d(i,k_rev) + hlos = max(0.0,-uh2d(I-1,k_rev)) + if ((((hup - hlos) - uh_sum) < 0.0) .and. & + ((0.5*hup - uh_sum) < 0.0)) then + uh2d(I,k_rev) = max(0.5*hup,hup-hlos,0.0) + uh_remain = uh_sum - uh2d(I,k_rev) + else + uh2d(I,k_rev) = uh_sum + uh_remain = 0.0 + exit + endif + endif + enddo ! k_rev endif - if(abs(uh_remain)>uh_neglect) then - if(k0.0) then + if (kuh_neglect) then + call MOM_error(WARNING,"Column integral of uh does not match after "//& + "upwards redistribution") + endif - enddo + enddo ! i-loop - ! Update layer thicknesses at the end - do k=1,nz ; do i=is,ie - h(i,j,k) = (h(i,j,k)*G%areaT(i,j) + (uh2d(I-1,k) - uh2d(I,k)))/G%areaT(i,j) - enddo ; enddo do k=1,nz ; do i=is-1,ie uh(I,j,k) = uh2d(I,k) enddo ; enddo @@ -448,10 +448,10 @@ end subroutine distribute_residual_uh_upwards !> In the case where offline advection has failed to converge, redistribute the u-flux !! into layers above -subroutine distribute_residual_vh_upwards(G, GV, h, vh) - type(ocean_grid_type), pointer :: G !< The ocean's grid structure - type(verticalGrid_type), pointer :: GV !< The ocean's vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thicknesses, in H (usually m or kg m-2) +subroutine distribute_residual_vh_upwards(G, GV, hvol, vh) + type(ocean_grid_type), pointer :: G + type(verticalGrid_type), pointer :: GV + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in ) :: hvol real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vh real, dimension(SZJB_(G),SZK_(G)) :: vh2d @@ -459,7 +459,7 @@ subroutine distribute_residual_vh_upwards(G, GV, h, vh) real, dimension(SZJ_(G),SZK_(G)) :: h2d real, dimension(SZJ_(G)) :: h2d_sum - real :: vh_neglect, vh_remain, vh_max, vh_add, vh_UB, vh_LB, vh_sum + real :: vh_neglect, vh_remain, vh_col, vh_sum real :: hup, hlos, min_h integer :: i, j, k, m, is, ie, js, je, nz, k_rev @@ -468,72 +468,76 @@ subroutine distribute_residual_vh_upwards(G, GV, h, vh) min_h = 0.1*GV%Angstrom - do i=is-1,ie + do i=is,ie ! Copy over uh and cell volume to working arrays - do k=1,nz ; do j=js-1,je + do k=1,nz ; do j=js-2,je+1 vh2d(J,k) = vh(i,J,k) enddo ; enddo - do k=1,nz ; do j=js-2,je+1 - h2d(j,k) = (h(i,j,k)-min_h)*G%areaT(i,j) + do k=1,nz ; do j=js-1,je+1 + h2d(j,k) = hvol(i,j,k)-min_h*G%areaT(i,j) enddo ; enddo do j=js-1,je + vh_col = SUM(vh2d(J,:)) do k=1,nz vh_remain = vh2d(J,k) - vh_neglect = GV%H_subroundoff*min(G%areaT(i,j),G%areaT(i,j+1)) - if(vh_remain<-vh_neglect) then - ! Set the mass flux to zero. This will be refilled in the first iteration - vh2d(J,k) = 0.0 - do k_rev=k,1,-1 - ! This lower bound only allows half of the layer to be depleted - vh_LB = -0.5*h2d(j+1,k_rev) - ! You can either add the difference between the lower bound and the - ! current uh, or the remaining mass transport to be distributed. - ! The max is there because it represents the minimum of these two with respect - ! to magnitude. The minimum is to guard against the case where uh2d>uh_LB - ! not quite the same potentially because of roundoff error - vh_add = min(max(vh_LB-vh2d(J,k_rev), vh_remain),0.0) - vh_remain = vh_remain - vh_add - vh2d(J,k_rev) = vh2d(J,k_rev) + vh_add - if(vh_remain>-vh_neglect) exit - enddo - elseif (vh_remain>vh_neglect) then - ! Set the amount in the layer with remaining fluxes to zero. This will be reset - ! in the first iteration of the redistribution loop - vh2d(J,k) = 0.0 - ! Loop to distribute remaining flux in layers above - do k_rev=k,1,-1 - ! This lower bound only allows half of the layer to be depleted - vh_UB = 0.5*h2d(j,k_rev) - vh_add = max(min(vh_UB-vh2d(J,k_rev), vh_remain), 0.0) - vh_remain = vh_remain - vh_add - vh2d(J,k_rev) = vh2d(J,k_rev) + vh_add - if(vh_remain0.0) then + do k_rev = k,1,-1 + vh_sum = vh_remain + vh2d(J,k_rev) + if (vh_sum<0.0) then ! Transport to the left + hup = h2d(j+1,k_rev) + hlos = MAX(0.0,vh2d(J+1,k_rev)) + if ((((hup - hlos) + vh_sum) < 0.0) .and. & + ((0.5*hup + vh_sum) < 0.0)) then + vh2d(J,k_rev) = MIN(-0.5*hup,-hup+hlos,0.0) + vh_remain = vh_sum - vh2d(J,k_rev) + else + vh2d(J,k_rev) = vh_sum + vh_remain = 0.0 + exit + endif + else ! Transport to the right + hup = h2d(j,k_rev) + hlos = MAX(0.0,-vh2d(J-1,k_rev)) + if ((((hup - hlos) - vh_sum) < 0.0) .and. & + ((0.5*hup - vh_sum) < 0.0)) then + vh2d(J,k_rev) = MAX(0.5*hup,hup-hlos,0.0) + vh_remain = vh_sum - vh2d(J,k_rev) + else + vh2d(J,k_rev) = vh_sum + vh_remain = 0.0 + exit + endif + endif + + enddo ! k_rev endif - if(abs(vh_remain)>vh_neglect) then - if(k0.0) then + if (k vh_neglect) then + call MOM_error(WARNING,"Column integral of vh does not match after "//& + "upwards redistribution") + endif enddo - ! Update layer thicknesses at the end - do k=1,nz ; do j=js,je - h(i,j,k) = (h(i,j,k)*G%areaT(i,j) + (vh2d(J-1,k) - vh2d(J,k)))/G%areaT(i,j) - enddo ; enddo do k=1,nz ; do j=js-1,je vh(i,J,k) = vh2d(J,k) enddo ; enddo enddo - end subroutine distribute_residual_vh_upwards !> add_diurnal_SW adjusts the shortwave fluxes in an forcying_type variable @@ -580,12 +584,221 @@ subroutine offline_add_diurnal_SW(fluxes, G, Time_start, Time_end) i2 = i+i_off ; j2 = j+j_off fluxes%sw(i2,j2) = fluxes%sw(i2,j2) * diurnal_factor fluxes%sw_vis_dir(i2,j2) = fluxes%sw_vis_dir(i2,j2) * diurnal_factor - fluxes%sw_vis_dif(i2,j2) = fluxes%sw_vis_dif(i2,j2) * diurnal_factor + fluxes%sw_vis_dif (i2,j2) = fluxes%sw_vis_dif (i2,j2) * diurnal_factor fluxes%sw_nir_dir(i2,j2) = fluxes%sw_nir_dir(i2,j2) * diurnal_factor - fluxes%sw_nir_dif(i2,j2) = fluxes%sw_nir_dif(i2,j2) * diurnal_factor + fluxes%sw_nir_dif (i2,j2) = fluxes%sw_nir_dif (i2,j2) * diurnal_factor enddo ; enddo end subroutine offline_add_diurnal_sw +!> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored +!! in a previous integration of the online model +subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_file, surf_file, h_end, & + uhtr, vhtr, temp_mean, salt_mean, mld, Kd, fluxes, ridx_sum, ridx_snap, read_mld, read_sw, & + read_ts_uvh, do_ale_in) + + type(ocean_grid_type), pointer, intent(inout) :: G !< Horizontal grid type + type(verticalGrid_type), pointer, intent(in ) :: GV !< Vertical grid type + integer, intent(in ) :: nk_input !< Number of levels in input file + character(len=*), intent(in ) :: mean_file !< Name of file with averages fields + character(len=*), intent(in ) :: sum_file !< Name of file with summed fields + character(len=*), intent(in ) :: snap_file !< Name of file with snapshot fields + character(len=*), intent(in ) :: surf_file !< Name of file with surface fields + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h_end !< End of timestep layer thickness + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp_mean !< Averaged temperature + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt_mean !< Averaged salinity + real, dimension(SZI_(G),SZJ_(G)), intent(inout) :: mld !< Averaged mixed layer depth + real, dimension(SZI_(G),SZJ_(G),SZK_(G)+1),intent(inout) :: Kd !< Averaged mixed layer depth + type(forcing), intent(inout) :: fluxes !< Fields with surface fluxes + integer, intent(in ) :: ridx_sum !< Read index for sum, mean, and surf files + integer, intent(in ) :: ridx_snap !< Read index for snapshot file + logical, intent(in ) :: read_mld !< True if reading in MLD + logical, intent(in ) :: read_sw !< True if reading in radiative fluxes + logical, intent(in ) :: read_ts_uvh !< True if reading in uh, vh, and h + logical, optional, intent(in ) :: do_ale_in !< True if using ALE algorithms + + logical :: do_ale + integer :: i, j, k, is, ie, js, je, nz + real :: Initer_vert + + do_ale = .false.; + if (present(do_ale_in) ) do_ale = do_ale_in + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + ! Check if reading in UH, VH, and h_end + if (read_ts_uvh) then + h_end(:,:,:) = 0.0 + temp_mean(:,:,:) = 0.0 + salt_mean(:,:,:) = 0.0 + uhtr(:,:,:) = 0.0 + vhtr(:,:,:) = 0.0 + ! Time-summed fields + call read_data(sum_file, 'uhtr_sum', uhtr(:,:,1:nk_input),domain=G%Domain%mpp_domain, & + timelevel=ridx_sum, position=EAST) + call read_data(sum_file, 'vhtr_sum', vhtr(:,:,1:nk_input), domain=G%Domain%mpp_domain, & + timelevel=ridx_sum, position=NORTH) + call read_data(snap_file, 'h_end', h_end(:,:,1:nk_input), domain=G%Domain%mpp_domain, & + timelevel=ridx_snap,position=CENTER) + call read_data(mean_file, 'temp', temp_mean(:,:,1:nk_input), domain=G%Domain%mpp_domain, & + timelevel=ridx_sum,position=CENTER) + call read_data(mean_file, 'salt', salt_mean(:,:,1:nk_input), domain=G%Domain%mpp_domain, & + timelevel=ridx_sum,position=CENTER) + endif + + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)>0.) then + temp_mean(:,:,nk_input:nz) = temp_mean(i,j,nk_input) + salt_mean(:,:,nk_input:nz) = salt_mean(i,j,nk_input) + endif + enddo ; enddo + + ! Check if reading vertical diffusivities or entrainment fluxes + call read_data( mean_file, 'Kd_interface', Kd(:,:,1:nk_input+1), domain=G%Domain%mpp_domain, & + timelevel=ridx_sum,position=CENTER) + + ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, + ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine + if (do_ale) then + if (.not. ASSOCIATED(fluxes%netMassOut)) then + allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) + fluxes%netMassOut(:,:) = 0.0 + endif + if (.not. ASSOCIATED(fluxes%netMassIn)) then + allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) + fluxes%netMassIn(:,:) = 0.0 + endif + + fluxes%netMassOut(:,:) = 0.0 + fluxes%netMassIn(:,:) = 0.0 + call read_data(surf_file,'massout_flux_sum',fluxes%netMassOut, domain=G%Domain%mpp_domain, & + timelevel=ridx_sum) + call read_data(surf_file,'massin_flux_sum', fluxes%netMassIn, domain=G%Domain%mpp_domain, & + timelevel=ridx_sum) + + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)<1.0) then + fluxes%netMassOut(i,j) = 0.0 + fluxes%netMassIn(i,j) = 0.0 + endif + enddo ; enddo + + endif + + if (read_mld) then + call read_data(surf_file, 'ePBL_h_ML', mld, domain=G%Domain%mpp_domain, timelevel=ridx_sum) + endif + + if (read_sw) then + ! Shortwave radiation is only needed for offline mode with biogeochemistry but without the coupler. + ! Need to double check, but set_opacity seems to only need the sum of the diffuse and + ! direct fluxes in the visible and near-infrared bands. For convenience, we store the + ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero + call read_data(mean_file,'sw_vis',fluxes%sw_vis_dir, domain=G%Domain%mpp_domain, & + timelevel=ridx_sum) + call read_data(mean_file,'sw_nir',fluxes%sw_nir_dir, domain=G%Domain%mpp_domain, & + timelevel=ridx_sum) + fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 + fluxes%sw_vis_dif (:,:) = fluxes%sw_vis_dir + fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 + fluxes%sw_nir_dif (:,:) = fluxes%sw_nir_dir + fluxes%sw = fluxes%sw_vis_dir + fluxes%sw_vis_dif + fluxes%sw_nir_dir + fluxes%sw_nir_dif + do j=js,je ; do i=is,ie + if (G%mask2dT(i,j)<1.0) then + fluxes%sw(i,j) = 0.0 + fluxes%sw_vis_dir(i,j) = 0.0 + fluxes%sw_nir_dir(i,j) = 0.0 + fluxes%sw_vis_dif (i,j) = 0.0 + fluxes%sw_nir_dif (i,j) = 0.0 + endif + enddo ; enddo + call pass_var(fluxes%sw,G%Domain) + call pass_var(fluxes%sw_vis_dir,G%Domain) + call pass_var(fluxes%sw_vis_dif,G%Domain) + call pass_var(fluxes%sw_nir_dir,G%Domain) + call pass_var(fluxes%sw_nir_dif,G%Domain) + endif + +end subroutine update_offline_from_files + +!> Fields for offline transport are copied from the stored arrays read during initialization +subroutine update_offline_from_arrays(G, GV, nk_input, ridx_sum, mean_file, sum_file, snap_file, uhtr, vhtr, & + hend, uhtr_all, vhtr_all, hend_all, temp, salt, temp_all, salt_all ) + type(ocean_grid_type), intent(inout) :: G !< Horizontal grid type + type(verticalGrid_type), intent(in ) :: GV !< Vertical grid type + integer, intent(in ) :: nk_input !< Number of levels in input file + integer, intent(in ) :: ridx_sum !< Index to read from + character(len=200), intent(in ) :: mean_file !< Name of file with averages fields + character(len=200), intent(in ) :: sum_file !< Name of file with summed fields + character(len=200), intent(in ) :: snap_file !< Name of file with snapshot fields + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(inout) :: uhtr !< Zonal mass fluxes + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(inout) :: vhtr !< Meridional mass fluxes + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: hend !< End of timestep layer thickness + real, dimension(:,:,:,:), allocatable, intent(inout) :: uhtr_all !< Zonal mass fluxes + real, dimension(:,:,:,:), allocatable, intent(inout) :: vhtr_all !< Meridional mass fluxes + real, dimension(:,:,:,:), allocatable, intent(inout) :: hend_all !< End of timestep layer thickness + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: temp !< Temperature array + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: salt !< Salinity array + real, dimension(:,:,:,:), allocatable, intent(inout) :: temp_all !< Temperature array + real, dimension(:,:,:,:), allocatable, intent(inout) :: salt_all !< Salinity array + + integer :: i, j, k, is, ie, js, je, nz + real, parameter :: fill_value = 0. + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + + ! Check that all fields are allocated (this is a redundant check) + if (.not. allocated(uhtr_all)) & + call MOM_error(FATAL, "uhtr_all not allocated before call to update_transport_from_arrays") + if (.not. allocated(vhtr_all)) & + call MOM_error(FATAL, "vhtr_all not allocated before call to update_transport_from_arrays") + if (.not. allocated(hend_all)) & + call MOM_error(FATAL, "hend_all not allocated before call to update_transport_from_arrays") + if (.not. allocated(temp_all)) & + call MOM_error(FATAL, "temp_all not allocated before call to update_transport_from_arrays") + if (.not. allocated(salt_all)) & + call MOM_error(FATAL, "salt_all not allocated before call to update_transport_from_arrays") + + ! Copy uh, vh, h_end, temp, and salt + do k=1,nk_input ; do j=js,je ; do i=is,ie + uhtr(I,j,k) = uhtr_all(I,j,k,ridx_sum) + vhtr(i,J,k) = vhtr_all(i,J,k,ridx_sum) + hend(i,j,k) = hend_all(i,j,k,ridx_sum) + temp(i,j,k) = temp_all(i,j,k,ridx_sum) + salt(i,j,k) = salt_all(i,j,k,ridx_sum) + enddo ; enddo ; enddo + + ! Fill the rest of the arrays with 0s (fill_value could probably be changed to a runtime parameter) + do k=nk_input+1,nz ; do j=js,je ; do i=is,ie + uhtr(I,j,k) = fill_value + vhtr(i,J,k) = fill_value + hend(i,j,k) = fill_value + temp(i,j,k) = fill_value + salt(i,j,k) = fill_value + enddo ; enddo ; enddo + +end subroutine update_offline_from_arrays + +!> Calculates the next timelevel to read from the input fields. This allows the 'looping' +!! of the fields +function next_modulo_time(inidx, numtime) + ! Returns the next time interval to be read + integer :: numtime ! Number of time levels in input fields + integer :: inidx ! The current time index + + integer :: read_index ! The index in the input files that corresponds + ! to the current timestep + + integer :: next_modulo_time + + read_index = mod(inidx+1,numtime) + if (read_index < 0) read_index = inidx-read_index + if (read_index == 0) read_index = numtime + + next_modulo_time = read_index + +end function next_modulo_time + end module MOM_offline_aux diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 1696f29c3b..75c1c1d7e7 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -1,10 +1,13 @@ +!> The routines here implement the offline tracer algorithm used in MOM6. These are called from step_offline +!! Some routines called here can be found in the MOM_offline_aux module. module MOM_offline_main use mpp_domains_mod, only : CENTER, CORNER, NORTH, EAST - -use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_tracer_final +use MOM_ALE, only : ALE_CS, ALE_main_offline, ALE_offline_inputs, ALE_offline_tracer_final use MOM_checksums, only : hchksum, uvchksum use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end +use MOM_cpu_clock, only : CLOCK_COMPONENT, CLOCK_SUBCOMPONENT +use MOM_cpu_clock, only : CLOCK_MODULE_DRIVER, CLOCK_MODULE, CLOCK_ROUTINE use MOM_diabatic_aux, only : diabatic_aux_CS use MOM_diabatic_driver, only : diabatic_CS, extract_diabatic_member use MOM_diabatic_aux, only : tridiagTS @@ -16,18 +19,19 @@ module MOM_offline_main use MOM_forcing_type, only : forcing use MOM_grid, only : ocean_grid_type use MOM_io, only : read_data +use MOM_offline_aux, only : update_offline_from_arrays, update_offline_from_files +use MOM_offline_aux, only : next_modulo_time, offline_add_diurnal_sw use MOM_offline_aux, only : update_h_horizontal_flux, update_h_vertical_flux, limit_mass_flux_3d use MOM_offline_aux, only : distribute_residual_uh_barotropic, distribute_residual_vh_barotropic use MOM_offline_aux, only : distribute_residual_uh_upwards, distribute_residual_vh_upwards -use MOM_offline_aux, only : offline_add_diurnal_sw use MOM_opacity, only : set_opacity, opacity_CS use MOM_open_boundary, only : ocean_OBC_type use MOM_shortwave_abs, only : optics_type use MOM_time_manager, only : time_type use MOM_tracer_advect, only : tracer_advect_CS, advect_tracer use MOM_tracer_diabatic, only : applyTracerBoundaryFluxesInOut -use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns -use MOM_tracer_registry, only : tracer_registry_type +use MOM_tracer_flow_control, only : tracer_flow_control_CS, call_tracer_column_fns, call_tracer_stocks +use MOM_tracer_registry, only : tracer_registry_type, MOM_tracer_chksum, MOM_tracer_chkinv use MOM_variables, only : thermo_var_ptrs use MOM_verticalGrid, only : verticalGrid_type @@ -36,52 +40,68 @@ module MOM_offline_main #include "MOM_memory.h" #include "version_variable.h" -type, public :: offline_transport_CS +type, public :: offline_transport_CS ; private !> Pointers to relevant fields from the main MOM control structure - type(ALE_CS), pointer :: ALE_CSp => NULL() - type(diabatic_CS), pointer :: diabatic_CSp => NULL() - type(diag_ctrl), pointer :: diag => NULL() - type(ocean_OBC_type), pointer :: OBC => NULL() - type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() - type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() - type(tracer_registry_type), pointer :: tracer_Reg => NULL() - type(thermo_var_ptrs), pointer :: tv => NULL() - type(ocean_grid_type), pointer :: G => NULL() - type(verticalGrid_type), pointer :: GV => NULL() - type(optics_type), pointer :: optics => NULL() - type(opacity_CS), pointer :: opacity_CSp => NULL() + type(ALE_CS), pointer :: ALE_CSp => NULL() + type(diabatic_CS), pointer :: diabatic_CSp => NULL() + type(diag_ctrl), pointer :: diag => NULL() + type(ocean_OBC_type), pointer :: OBC => NULL() + type(tracer_advect_CS), pointer :: tracer_adv_CSp => NULL() + type(tracer_flow_control_CS), pointer :: tracer_flow_CSp => NULL() + type(tracer_registry_type), pointer :: tracer_Reg => NULL() + type(thermo_var_ptrs), pointer :: tv => NULL() + type(ocean_grid_type), pointer :: G => NULL() + type(verticalGrid_type), pointer :: GV => NULL() + type(optics_type), pointer :: optics => NULL() + type(opacity_CS), pointer :: opacity_CSp => NULL() !> Variables related to reading in fields from online run - integer :: start_index ! Timelevel to start - integer :: iter_no ! Timelevel to start - integer :: numtime ! How many timelevels in the input fields - integer :: accumulated_time ! Length of time accumulatedi n the current offline interval - integer :: & ! Index of each of the variables to be read in - ridx_sum = -1, & ! Separate indices for each variabile if they are - ridx_snap = -1 ! setoff from each other in time + integer :: start_index !< Timelevel to start + integer :: iter_no !< Timelevel to start + integer :: numtime !< How many timelevels in the input fields + integer :: accumulated_time !< Length of time accumulated in the current offline interval + integer :: & !< Index of each of the variables to be read in + ridx_sum = -1, & !! Separate indices for each variable if they are + ridx_snap = -1 !! setoff from each other in time + integer :: nk_input !! Number of input levels in the input fields character(len=200) :: offlinedir ! Directory where offline fields are stored - character(len=200) :: & ! ! Names of input files - snap_file, & - sum_file, & - mean_file - character(len=20) :: redistribute_method - logical :: fields_are_offset ! True if the time-averaged fields and snapshot fields are + character(len=200) :: & ! Names of input files + surf_file, & !< Contains surface fields (2d arrays) + snap_file, & !< Snapshotted fields (layer thicknesses) + sum_file, & !< Fields which are accumulated over time + mean_file !< Fields averaged over time + character(len=20) :: redistribute_method !< 'barotropic' if evenly distributing extra flow + !! throughout entire watercolumn, 'upwards', + !! if trying to do it just in the layers above + !! 'both' if both methods are used + character(len=20) :: mld_var_name !< Name of the mixed layer depth variable to use + logical :: fields_are_offset !< True if the time-averaged fields and snapshot fields are ! offset by one time level - logical :: x_before_y ! Which horizontal direction is advected first - logical :: print_adv_offline ! Prints out some updates each advection sub interation - logical :: skip_diffusion ! Skips horizontal diffusion of tracers - logical :: read_sw ! Read in averaged values for shortwave radiation - logical :: read_mld ! Check to see whether mixed layer depths should be read in - logical :: diurnal_sw ! Adds a synthetic diurnal cycle on shortwave radiation + logical :: x_before_y !< Which horizontal direction is advected first + logical :: print_adv_offline !< Prints out some updates each advection sub interation + logical :: skip_diffusion !< Skips horizontal diffusion of tracers + logical :: read_sw !< Read in averaged values for shortwave radiation + logical :: read_mld !< Check to see whether mixed layer depths should be read in + logical :: diurnal_sw !< Adds a synthetic diurnal cycle on shortwave radiation logical :: debug - !> Variables controlling some of the numerical considerations of offline transport - integer :: num_off_iter - real :: dt_offline ! Timestep used for offline tracers - real :: dt_offline_vertical ! Timestep used for calls to tracer vertical physics - real :: max_off_cfl=0.5 ! Hardcoded for now, only used in non-ALE mode - real :: evap_CFL_limit, minimum_forcing_depth - + logical :: redistribute_barotropic !< Redistributes column-summed residual transports throughout + !! a column weighted by thickness + logical :: redistribute_upwards !< Redistributes remaining fluxes only in layers above + !! the current one based as the max allowable transport + !! in that cell + logical :: read_all_ts_uvh !< If true, then all timelevels of temperature, salinity, mass transports, and + !! Layer thicknesses are read during initialization + !! Variables controlling some of the numerical considerations of offline transport + integer :: num_off_iter !< Number of advection iterations per offline step + integer :: num_vert_iter !< Number of vertical iterations per offline step + integer :: off_ale_mod !< Sets how frequently the ALE step is done during the advection + real :: dt_offline ! Timestep used for offline tracers + real :: dt_offline_vertical ! Timestep used for calls to tracer vertical physics + real :: evap_CFL_limit, minimum_forcing_depth !< Copied from diabatic_CS controlling how tracers + !! follow freshwater fluxes + real :: Kd_max !< Runtime parameter specifying the maximum value of vertical diffusivity + real :: min_residual !< The minimum amount of total mass flux before exiting the main advection routine !> Diagnostic manager IDs for some fields that may be of interest when doing offline transport integer :: & id_uhr = -1, & @@ -89,50 +109,80 @@ module MOM_offline_main id_ear = -1, & id_ebr = -1, & id_hr = -1, & + id_hdiff = -1, & id_uhr_redist = -1, & id_vhr_redist = -1, & + id_uhr_end = -1, & + id_vhr_end = -1, & + id_eta_pre_distribute = -1, & + id_eta_post_distribute = -1, & id_h_redist = -1, & - id_eta_diff = -1 + id_eta_diff_end = -1 + + !> Diagnostic IDs for the regridded/remapped input fields + integer :: & + id_uhtr_regrid = -1, & + id_vhtr_regrid = -1, & + id_temp_regrid = -1, & + id_salt_regrid = -1, & + id_h_regrid = -1 + + !> IDs for timings of various offline components + integer :: & + id_clock_read_fields = -1, & + id_clock_offline_diabatic = -1, & + id_clock_offline_adv = -1, & + id_clock_redistribute = -1 !> Variables that may need to be stored between calls to step_MOM - real ALLOCABLE_, dimension(NIMEMB_PTR_,NJMEM_,NKMEM_) :: uhtr - real ALLOCABLE_, dimension(NIMEM_,NJMEMB_PTR_,NKMEM_) :: vhtr + real, allocatable, dimension(:,:,:) :: uhtr + real, allocatable, dimension(:,:,:) :: vhtr ! Fields at T-point - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - eatr, & ! Amount of fluid entrained from the layer above within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - ebtr ! Amount of fluid entrained from the layer below within - ! one time step (m for Bouss, kg/m^2 for non-Bouss) - ! Work arrays for temperature and salinity - ! Arrays for temperature and salinity - real ALLOCABLE_, dimension(NIMEM_,NJMEM_,NKMEM_) :: & - temp_mean, salt_mean, & - h_end - real ALLOCABLE_, dimension(NIMEM_,NJMEM_) :: & - netMassIn, netMassOut - real, allocatable, dimension(:,:) :: & - mld ! Mixed layer depths at thickness points, in H. + real, allocatable, dimension(:,:,:) :: & + eatr, & !< Amount of fluid entrained from the layer above within + !! one time step (m for Bouss, kg/m^2 for non-Bouss) + ebtr !< Amount of fluid entrained from the layer below within + !! one time step (m for Bouss, kg/m^2 for non-Bouss) + ! Fields at T-points on interfaces + real, allocatable, dimension(:,:,:) :: Kd !< Vertical diffusivity + real, allocatable, dimension(:,:,:) :: h_end !< Thicknesses at the end of offline timestep + + real, allocatable, dimension(:,:) :: netMassIn !< Freshwater fluxes into the ocean + real, allocatable, dimension(:,:) :: netMassOut !< Freshwater fluxes out of the ocean + real, allocatable, dimension(:,:) :: mld !< Mixed layer depths at thickness points, in H. + + !> Allocatable arrays to read in entire fields during initialization + real, allocatable, dimension(:,:,:,:) :: & + uhtr_all, vhtr_all, hend_all, temp_all, salt_all end type offline_transport_CS public offline_advection_ale public offline_redistribute_residual public offline_diabatic_ale +public offline_fw_fluxes_into_ocean +public offline_fw_fluxes_out_ocean public offline_advection_layer -public transport_by_files -public offline_transport_init public register_diags_offline_transport +public update_offline_fields +public insert_offline_main +public extract_offline_main +public post_offline_convergence_diags +public offline_transport_init +public offline_transport_end contains -subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ALE,& - h_pre, uhtr, vhtr, converged) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM - integer :: id_clock_ALE !< ID for the ALE clock +!> 3D advection is done by doing flux-limited nonlinear horizontal advection interspersed with an ALE +!! regridding/remapping step. The loop in this routine is exited if remaining residual transports are below +!! a runtime-specified value or a maximum number of iterations is reached. +subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock_ale, h_pre, uhtr, vhtr, converged) + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< time interval + type(offline_transport_CS), pointer :: CS !< control structure for offline module + integer, intent(in) :: id_clock_ALE !< Clock for ALE routines real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Zonal mass transport real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Meridional mass transport @@ -148,7 +198,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Meridional mass transports real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub - real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are + real :: prev_tot_residual, tot_residual ! Used to keep track of how close to convergence we are ! Variables used to keep track of layer thicknesses at various points in the code real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & @@ -164,6 +214,11 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock logical :: z_first, x_before_y real :: evap_CFL_limit, minimum_forcing_depth, dt_iter, dt_offline + integer :: nstocks + real :: stock_values(MAX_FIELDS_) + character*20 :: debug_msg + call cpu_clock_begin(CS%id_clock_offline_adv) + ! Grid-related pointer assignments G => CS%G GV => CS%GV @@ -189,7 +244,7 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock uhtr_sub(:,:,:) = 0.0 vhtr_sub(:,:,:) = 0.0 - ! Initialize logicals + ! converged should only be true if there are no remaining mass fluxes converged = .false. ! Tracers are transported using the stored mass fluxes. Where possible, operators are Strang-split around @@ -213,103 +268,129 @@ subroutine offline_advection_ale(fluxes, Time_start, time_interval, CS, id_clock ! Copy over the horizontal mass fluxes from the total mass fluxes do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB - uhtr_sub(i,j,k) = uhtr(i,j,k) + uhtr_sub(I,j,k) = uhtr(I,j,k) enddo ; enddo ; enddo do k=1,nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr_sub(i,j,k) = vhtr(i,j,k) + vhtr_sub(i,J,k) = vhtr(i,J,k) + enddo ; enddo ; enddo + do k=1,nz ; do j=js,je ; do i=is,ie + h_new(i,j,k) = h_pre(i,j,k) enddo ; enddo ; enddo - call pass_vector(uhtr_sub,vhtr_sub,G%Domain) - if(CS%debug) then + if (CS%debug) then call hchksum(h_pre,"h_pre before transport",G%HI) call uvchksum("[uv]htr_sub before transport", uhtr_sub, vhtr_sub, G%HI) endif + tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + if (CS%print_adv_offline) then + if (is_root_pe()) then + write(*,'(A,ES24.16)') "Main advection starting transport: ", tot_residual + endif + endif ! This loop does essentially a flux-limited, nonlinear advection scheme until all mass fluxes ! are used. ALE is done after the horizontal advection. do iter=1,CS%num_off_iter - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + do k=1,nz ; do j=js,je ; do i=is,ie + h_vol(i,j,k) = h_new(i,j,k)*G%areaT(i,j) + h_pre(i,j,k) = h_new(i,j,k) enddo ; enddo ; enddo + if(CS%debug) then + call hchksum(h_vol,"h_vol before advect",G%HI) + call uvchksum("[uv]htr_sub before advect", uhtr_sub, vhtr_sub, G%HI) + write(debug_msg, '(A,I4.4)') 'Before advect ', iter + call MOM_tracer_chkinv(debug_msg, G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + call advect_tracer(h_pre, uhtr_sub, vhtr_sub, CS%OBC, CS%dt_offline, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=1, & uhr_out=uhtr, vhr_out=vhtr, h_out=h_new, x_first_in=x_before_y) ! Switch the direction every iteration x_before_y = .not. x_before_y ! Update the new layer thicknesses after one round of advection has happened - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_pre(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + do k=1,nz ; do j=js,je ; do i=is,ie + h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) enddo ; enddo ; enddo - if(CS%debug) then - call hchksum(h_pre,"h_pre before ALE",G%HI) - endif - - ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration - call cpu_clock_begin(id_clock_ALE) - call ALE_main_offline(G, GV, h_pre, CS%tv, & - CS%tracer_Reg, CS%ALE_CSp, CS%dt_offline) - call cpu_clock_end(id_clock_ALE) - - call pass_var(h_pre, G%Domain) - if(CS%debug) then - call hchksum(h_pre,"h_pre after ALE",G%HI) + if (MODULO(iter,CS%off_ale_mod)==0) then + ! Do ALE remapping/regridding to allow for more advection to occur in the next iteration + call pass_var(h_new,G%Domain) + if (CS%debug) then + call hchksum(h_new,"h_new before ALE",G%HI) + write(debug_msg, '(A,I4.4)') 'Before ALE ', iter + call MOM_tracer_chkinv(debug_msg, G, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + call cpu_clock_begin(id_clock_ALE) + call ALE_main_offline(G, GV, h_new, CS%tv, CS%tracer_Reg, CS%ALE_CSp, CS%dt_offline) + call cpu_clock_end(id_clock_ALE) + + if (CS%debug) then + call hchksum(h_new,"h_new after ALE",G%HI) + write(debug_msg, '(A,I4.4)') 'After ALE ', iter + call MOM_tracer_chkinv(debug_msg, G, h_new, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif endif - ! Copy over remaining mass transports - do k=1,nz ; do j=jsd,jed ; do i=isdB,iedB - uhtr_sub(i,j,k) = uhtr(i,j,k) - enddo ; enddo ; enddo - do k=1,nz ; do j=jsdB,jedB ; do i=isd,ied - vhtr_sub(i,j,k) = vhtr(i,j,k) + do k=1,nz; do j=js,je ; do i=is,ie + uhtr_sub(I,j,k) = uhtr(I,j,k) + vhtr_sub(i,J,k) = vhtr(i,J,k) enddo ; enddo ; enddo + call pass_var(h_new, G%Domain) call pass_vector(uhtr_sub,vhtr_sub,G%Domain) - sum_u = 0.0 - do k=1,nz; do j=js,je ; do i=is-1,ie - sum_u = sum_u + abs(uhtr_sub(i,j,k)) - enddo; enddo; enddo - sum_v = 0.0 - do k=1,nz; do j=js-1,je; do i=is,ie - sum_v = sum_v + abs(vhtr_sub(i,j,k)) - enddo; enddo ; enddo - - call sum_across_PEs(sum_u) - call sum_across_PEs(sum_v) - if(CS%print_adv_offline .and. is_root_pe()) & - print *, "Remaining transport: u", sum_u, "v", sum_v - - if(sum_u+sum_v==0.0) then - if(is_root_pe()) print *, "Converged after iteration", iter + ! Check for whether we've used up all the advection, or if we need to move on because + ! advection has stalled + tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + if (CS%print_adv_offline) then + if (is_root_pe()) then + write(*,'(A,ES24.16)') "Main advection remaining transport: ", tot_residual + endif + endif + ! If all the mass transports have been used u, then quit + if (tot_residual == 0.0) then + if (is_root_pe()) write(0,*) "Converged after iteration", iter converged = .true. exit - else - converged=.false. endif + ! If advection has stalled or the remaining residual is less than a specified amount, quit + if ( (tot_residual == prev_tot_residual) .or. (tot_residual In the case where the main advection routine did not converge, something needs to be done with the remaining +!! transport. Two different ways are offered, 'barotropic' means that the residual is distributed equally +!! throughout the water column. 'upwards' attempts to redistribute the transport in the layers above and will +!! eventually work down the entire water column +subroutine offline_redistribute_residual(CS, h_pre, uhtr, vhtr, converged) + type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(in) :: h_end !< target layer thicknesses real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Zonal mass transport real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Meridional mass transport - logical, intent(in) :: converged + logical, intent(in ) :: converged type(ocean_grid_type), pointer :: G => NULL() ! Pointer to a structure containing ! metrics and related information @@ -321,14 +402,14 @@ subroutine offline_redistribute_residual(CS, h_pre, h_end, uhtr, vhtr, converged h_new, & h_vol - ! Used to calculate the eta_diff diagnostic - real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: & - eta_pre, & - eta_end + ! Used to calculate the eta diagnostics + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_work real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhr !< Zonal mass transport real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhr !< Meridional mass transport - integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz + integer :: i, j, k, m, is, ie, js, je, isd, ied, jsd, jed, nz, iter + real :: prev_tot_residual, tot_residual, stock_values(MAX_FIELDS_) + integer :: nstocks ! Assign grid pointers G => CS%G @@ -339,19 +420,14 @@ subroutine offline_redistribute_residual(CS, h_pre, h_end, uhtr, vhtr, converged x_before_y = CS%x_before_y - uhr(:,:,:) = uhtr - vhr(:,:,:) = vhtr - - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) - enddo ; enddo ; enddo - call pass_var(h_vol,G%Domain) - call pass_vector(uhtr,vhtr,G%Domain) - - if (CS%debug) then - call hchksum(h_pre,"h_pre before upwards redistribute",G%HI, haloshift = 1) - call hchksum(h_vol,"h_vol before upwards redistribute",G%HI) - call uvchksum("[uv]htr before upwards redistribute", uhtr, vhtr, G%HI) + if (CS%id_eta_pre_distribute>0) then + eta_work(:,:) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + if (h_pre(i,j,k)>GV%Angstrom) then + eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) + endif + enddo ; enddo ; enddo + call post_data(CS%id_eta_pre_distribute,eta_work,CS%diag) endif ! These are used to find out how much will be redistributed in this routine @@ -359,127 +435,252 @@ subroutine offline_redistribute_residual(CS, h_pre, h_end, uhtr, vhtr, converged if (CS%id_uhr_redist>0) call post_data(CS%id_uhr_redist, uhtr, CS%diag) if (CS%id_vhr_redist>0) call post_data(CS%id_vhr_redist, vhtr, CS%diag) - ! First try to distribute the residual upwards and advect - if(x_before_y) then - call distribute_residual_uh_upwards(G, GV, h_pre, uhtr) - call pass_var(h_pre,G%Domain) - call distribute_residual_vh_upwards(G, GV, h_pre, vhtr) - call pass_var(h_pre,G%Domain) - else - call distribute_residual_vh_upwards(G, GV, h_pre, vhtr) - call pass_var(h_pre,G%Domain) - call distribute_residual_uh_upwards(G, GV, h_pre, uhtr) - call pass_var(h_pre,G%Domain) - endif - call pass_vector(uhtr,vhtr,G%Domain) + if (converged) return if (CS%debug) then - call hchksum(h_vol,"h_vol after upwards redistribute",G%HI,haloshift = 1) - call uvchksum("[uv]h after upwards redistribute", uhtr, vhtr, G%HI) + call MOM_tracer_chkinv("Before redistribute ", G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & - h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_vol(i,j,k) = h_new(i,j,k) - h_new(i,j,k) = h_vol(i,j,k)/G%areaT(i,j) - enddo ; enddo ; enddo - - call pass_var(h_vol,G%Domain) - call pass_var(h_new,G%Domain) - call pass_vector(uhr,vhr,G%Domain) + call cpu_clock_begin(CS%id_clock_redistribute) + + if (CS%redistribute_upwards .or. CS%redistribute_barotropic) then + do iter = 1, CS%num_off_iter + + ! Perform upwards redistribution + if (CS%redistribute_upwards) then + + ! Calculate the layer volumes at beginning of redistribute + do k=1,nz ; do j=js,je ; do i=is,ie + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo ; enddo ; enddo + call pass_var(h_vol,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) + + ! Store volumes for advect_tracer + h_pre(:,:,:) = h_vol(:,:,:) + + if (CS%debug) then + call MOM_tracer_chksum("Before upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + endif + + if (x_before_y) then + call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) + call distribute_residual_vh_upwards(G, GV, h_vol, vhtr) + else + call distribute_residual_vh_upwards(G, GV, h_vol, vhtr) + call distribute_residual_uh_upwards(G, GV, h_vol, uhtr) + endif + + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & + h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + + if (CS%debug) then + call MOM_tracer_chksum("After upwards redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + endif + + ! Convert h_new back to layer thickness for ALE remapping + do k=1,nz ; do j=js,je ; do i=is,ie + uhtr(I,j,k) = uhr(I,j,k) + vhtr(i,J,k) = vhr(i,J,k) + h_vol(i,j,k) = h_new(i,j,k) + h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo + + endif ! redistribute upwards + + ! Perform barotropic redistribution + if (CS%redistribute_barotropic) then + + ! Calculate the layer volumes at beginning of redistribute + do k=1,nz ; do j=js,je ; do i=is,ie + h_vol(i,j,k) = h_pre(i,j,k)*G%areaT(i,j) + enddo ; enddo ; enddo + call pass_var(h_vol,G%Domain) + call pass_vector(uhtr,vhtr,G%Domain) + + ! Copy h_vol to h_pre for advect_tracer routine + h_pre(:,:,:) = h_vol(:,:,:) + + if (CS%debug) then + call MOM_tracer_chksum("Before barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + call uvchksum("[uv]tr before upwards redistribute", uhtr, vhtr, G%HI) + endif + + if (x_before_y) then + call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) + call distribute_residual_vh_barotropic(G, GV, h_vol, vhtr) + else + call distribute_residual_vh_barotropic(G, GV, h_vol, vhtr) + call distribute_residual_uh_barotropic(G, GV, h_vol, uhtr) + endif + + call advect_tracer(h_pre, uhtr, vhtr, CS%OBC, CS%dt_offline, G, GV, & + CS%tracer_adv_CSp, CS%tracer_Reg, h_prev_opt = h_pre, max_iter_in=1, & + h_out=h_new, uhr_out=uhr, vhr_out=vhr, x_first_in=x_before_y) + + if (CS%debug) then + call MOM_tracer_chksum("After barotropic redistribute ", CS%tracer_Reg%Tr, CS%tracer_Reg%ntr, G) + endif + + ! Convert h_new back to layer thickness for ALE remapping + do k=1,nz ; do j=js,je ; do i=is,ie + uhtr(I,j,k) = uhr(I,j,k) + vhtr(i,J,k) = vhr(i,J,k) + h_vol(i,j,k) = h_new(i,j,k) + h_new(i,j,k) = h_new(i,j,k)/G%areaT(i,j) + h_pre(i,j,k) = h_new(i,j,k) + enddo ; enddo ; enddo - if (CS%debug) then - call hchksum(h_vol,"h_vol before barotropic redistribute",G%HI) - call hchksum(h_new,"h_new before barotropic redistribute",G%HI) - call uvchksum("[uv]hr before barotropic redistribute", uhr, vhr, G%HI) - endif + endif ! redistribute barotropic - ! Then check if there's any transport left and if so, distribute it equally - ! throughout the rest of the water column - if(x_before_y) then - call distribute_residual_uh_barotropic(G, GV, h_new, uhr) - call pass_var(h_new,G%Domain) - call distribute_residual_vh_barotropic(G, GV, h_new, vhr) - call pass_var(h_new,G%Domain) - else - call distribute_residual_vh_barotropic(G, GV, h_new, vhr) - call pass_var(h_new,G%Domain) - call distribute_residual_uh_barotropic(G, GV, h_new, uhr) - call pass_var(h_new,G%Domain) - endif - call pass_vector(uhr,vhr,G%Domain) - if (CS%debug) then - call hchksum(h_vol,"h_vol after barotropic redistribute",G%HI) - call uvchksum("[uv]hr after barotropic redistribute", uhr, vhr, G%HI) - endif + ! Check to see if all transport has been exhausted + tot_residual = remaining_transport_sum(CS, uhtr, vhtr) + if (CS%print_adv_offline) then + if (is_root_pe()) then + write(*,'(A,ES24.16)') "Residual advection remaining transport: ", tot_residual + endif + endif + ! If the remaining residual is 0, then this return is done + if (tot_residual==0.0 ) then + exit + endif - call advect_tracer(h_new, uhr, vhr, CS%OBC, CS%dt_offline, G, GV, & - CS%tracer_adv_CSp, CS%tracer_Reg, h_vol, max_iter_in=2, & - h_out=h_pre, uhr_out=uhtr, vhr_out=vhtr, x_first_in=x_before_y) + if ( (tot_residual == prev_tot_residual) .or. (tot_residual0.0 ) print *, "Remaining uhtr i, j, k: ", uhr(i,j,k), i, j, k + if (CS%id_eta_post_distribute>0) then + eta_work(:,:) = 0.0 + do k=1,nz ; do j=js,je ; do i=is,ie + if (h_pre(i,j,k)>GV%Angstrom) then + eta_work(i,j) = eta_work(i,j) + h_pre(i,j,k) + endif enddo ; enddo ; enddo + call post_data(CS%id_eta_post_distribute,eta_work,CS%diag) + endif - do k=1,nz ; do j=js-1,je ; do i=is,ie - if( abs(vhtr(i,j,k))>0.0 ) print *, "Remaining vhtr i, j, k: ", vhr(i,j,k), i, j, k - enddo ; enddo ; enddo + if (CS%id_uhr>0) call post_data(CS%id_uhr,uhtr,CS%diag) + if (CS%id_vhr>0) call post_data(CS%id_vhr,vhtr,CS%diag) + if (CS%debug) then + call hchksum(h_pre,"h_pre after redistribute",G%HI) + call uvchksum("uhtr after redistribute", uhtr, vhtr, G%HI) + call MOM_tracer_chkinv("after redistribute ", G, h_new, CS%tracer_Reg%Tr, CS%tracer_Reg%ntr) endif - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - h_pre(i,j,k) = h_pre(i,j,k)/G%areaT(i,j) - enddo ; enddo ; enddo - call pass_var(h_pre,G%Domain) - - ! This diagnostic can be used to identify which grid points did not converge within - ! the specified number of advection sub iterations - if(CS%id_eta_diff>0) then - eta_pre(:,:) = 0.0 - eta_end(:,:) = 0.0 - do k=1,nz ; do j=jsd,jed ; do i=isd,ied - if(h_pre(i,j,k)>GV%Angstrom) eta_pre(i,j) = eta_pre(i,j)+h_pre(i,j,k) - if(h_end(i,j,k)>GV%Angstrom) eta_end(i,j) = eta_end(i,j)+h_end(i,j,k) - enddo ; enddo; enddo + call cpu_clock_end(CS%id_clock_redistribute) - call post_data(CS%id_eta_diff,eta_pre-eta_end,CS%diag) +end subroutine offline_redistribute_residual - endif +!> Sums any non-negligible remaining transport to check for advection convergence +real function remaining_transport_sum(CS, uhtr, vhtr) + type(offline_transport_CS), pointer :: CS !< control structure for offline module + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(in ) :: uhtr !< Zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(in ) :: vhtr !< Meridional mass transport - if(CS%id_uhr>0) call post_data(CS%id_uhr,uhtr,CS%diag) - if(CS%id_vhr>0) call post_data(CS%id_vhr,vhtr,CS%diag) + ! Local variables + integer :: i, j, k + integer :: is, ie, js, je, nz + real :: h_min !< A layer thickness below roundoff from GV type + real :: uh_neglect !< A small value of zonal transport that effectively is below roundoff error + real :: vh_neglect !< A small value of meridional transport that effectively is below roundoff error + + nz = CS%GV%ke + is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + + h_min = CS%GV%H_subroundoff + + remaining_transport_sum = 0. + do k=1,nz; do j=js,je ; do i=is,ie + uh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i+1,j)) + vh_neglect = h_min*MIN(CS%G%areaT(i,j),CS%G%areaT(i,j+1)) + if (ABS(uhtr(I,j,k))>uh_neglect) then + remaining_transport_sum = remaining_transport_sum + ABS(uhtr(I,j,k)) + endif + if (ABS(vhtr(i,J,k))>vh_neglect) then + remaining_transport_sum = remaining_transport_sum + ABS(vhtr(i,J,k)) + endif + enddo; enddo; enddo + call sum_across_PEs(remaining_transport_sum) -end subroutine offline_redistribute_residual +end function remaining_transport_sum -subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, dt, CS, h_pre, eatr, ebtr) +!> The vertical/diabatic driver for offline tracers. First the eatr/ebtr associated with the interpolated +!! vertical diffusivities are calculated and then any tracer column functions are done which can include +!! vertical diffuvities and source/sink terms. +subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, CS, h_pre, eatr, ebtr) type(forcing), intent(inout) :: fluxes !< pointers to forcing fields type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type type(time_type), intent(in) :: Time_end !< time interval - real, intent(in) :: dt !< Time step to be used for column functions type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(in) :: eatr !< Entrainment from layer above - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(in) :: ebtr !< Entrainment from layer below + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: eatr !< Entrainment from layer above + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: ebtr !< Entrainment from layer below real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: sw, sw_vis, sw_nir !< Save old value of shortwave radiation - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: zero_3dh - zero_3dh(:,:,:) = 0.0 + real :: hval + integer :: i,j,k + integer :: is, ie, js, je, nz + integer :: k_nonzero + real :: stock_values(MAX_FIELDS_) + real :: Kd_bot + integer :: nstocks + nz = CS%GV%ke + is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec + + call cpu_clock_begin(CS%id_clock_offline_diabatic) + + if (is_root_pe()) write (0,*) "Applying tracer source, sinks, and vertical mixing" - if(CS%debug) then + if (CS%debug) then call hchksum(h_pre,"h_pre before offline_diabatic_ale",CS%G%HI) call hchksum(eatr,"eatr before offline_diabatic_ale",CS%G%HI) call hchksum(ebtr,"ebtr before offline_diabatic_ale",CS%G%HI) + call MOM_tracer_chkinv("Before offline_diabatic_ale", CS%G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif - if(CS%diurnal_SW .and. CS%read_sw) then + eatr(:,:,:) = 0. + ebtr(:,:,:) = 0. + ! Calculate eatr and ebtr if vertical diffusivity is read + ! Because the saved remapped diagnostics from the online run assume a zero minimum thickness + ! but ALE may have a minimum thickness. Flood the diffusivities for all layers with the value + ! of Kd closest to the bottom which is non-zero + do j=js,je ; do i=is,ie + k_nonzero = nz+1 + ! Find the nonzero bottom Kd + do k=nz+1,1,-1 + if (CS%Kd(i,j,k)>0.) then + Kd_bot = CS%Kd(i,j,k) + k_nonzero = k + exit + endif + enddo + ! Flood the bottom interfaces + do k=k_nonzero,nz+1 + CS%Kd(i,j,k) = Kd_bot + enddo + enddo ; enddo + + do j=js,je ; do i=is,ie + eatr(i,j,1) = 0. + enddo ; enddo + do k=2,nz ; do j=js,je ; do i=is,ie + hval=1.0/(CS%GV%H_subroundoff + 0.5*(h_pre(i,j,k-1) + h_pre(i,j,k))) + eatr(i,j,k) = (CS%GV%m_to_H**2) * CS%dt_offline_vertical * hval * CS%Kd(i,j,k) + ebtr(i,j,k-1) = eatr(i,j,k) + enddo ; enddo ; enddo + do j=js,je ; do i=is,ie + ebtr(i,j,nz) = 0. + enddo ; enddo + + ! Add diurnal cycle for shortwave radiation (only used if run in ocean-only mode) + if (CS%diurnal_SW .and. CS%read_sw) then sw(:,:) = fluxes%sw sw_vis(:,:) = fluxes%sw_vis_dir sw_nir(:,:) = fluxes%sw_nir_dir @@ -489,35 +690,117 @@ subroutine offline_diabatic_ale(fluxes, Time_start, Time_end, dt, CS, h_pre, eat if (associated(CS%optics)) & call set_opacity(CS%optics, fluxes, CS%G, CS%GV, CS%opacity_CSp) - ! Do the tracer sources and sinks and also the vertical mixing - call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, & - fluxes, CS%mld, dt, CS%G, CS%GV, CS%tv, & - CS%optics, CS%tracer_flow_CSp, CS%debug, & - evap_CFL_limit=CS%evap_CFL_limit, & - minimum_forcing_depth=CS%minimum_forcing_depth) - ! This next line is called to calculate new layer thicknesses based on the freshwater fluxes - call applyTracerBoundaryFluxesInOut(CS%G, CS%GV, zero_3dh, dt, fluxes, h_pre, & - CS%evap_CFL_limit, CS%minimum_forcing_depth) - - if(CS%diurnal_SW .and. CS%read_sw) then + ! Note that tracerBoundaryFluxesInOut within this subroutine should NOT be called + ! as the freshwater fluxes have already been accounted for + call call_tracer_column_fns(h_pre, h_pre, eatr, ebtr, fluxes, CS%MLD, CS%dt_offline_vertical, CS%G, CS%GV, & + CS%tv, CS%optics, CS%tracer_flow_CSp, CS%debug) + + if (CS%diurnal_SW .and. CS%read_sw) then fluxes%sw(:,:) = sw fluxes%sw_vis_dir(:,:) = sw_vis fluxes%sw_nir_dir(:,:) = sw_nir endif - if(CS%debug) then + if (CS%debug) then call hchksum(h_pre,"h_pre after offline_diabatic_ale",CS%G%HI) call hchksum(eatr,"eatr after offline_diabatic_ale",CS%G%HI) call hchksum(ebtr,"ebtr after offline_diabatic_ale",CS%G%HI) + call MOM_tracer_chkinv("After offline_diabatic_ale", CS%G, h_pre, CS%tracer_reg%Tr, CS%tracer_reg%ntr) endif + call cpu_clock_end(CS%id_clock_offline_diabatic) + end subroutine offline_diabatic_ale +!> Apply positive freshwater fluxes (into the ocean) and update netMassOut with only the negative +!! (out of the ocean) fluxes +subroutine offline_fw_fluxes_into_ocean(G, GV, CS, fluxes, h, in_flux_optional) + type(offline_transport_CS), intent(inout) :: CS !< Offline control structure + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< Surface fluxes container + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units + !> The total time-integrated amount of tracer that leaves with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: in_flux_optional + + integer :: i, j, m + real, dimension(SZI_(G),SZJ_(G)) :: negative_fw !< store all negative fluxes + logical :: update_h !< Flag for whether h should be updated + + if ( present(in_flux_optional) ) & + call MOM_error(WARNING, "Positive freshwater fluxes with non-zero tracer concentration not supported yet") + + ! Set all fluxes to 0 + negative_fw(:,:) = 0. + + ! Sort fluxes into positive and negative + do j=G%jsc,G%jec ; do i=G%isc,G%iec + if (fluxes%netMassOut(i,j)<0.0) then + negative_fw(i,j) = fluxes%netMassOut(i,j) + fluxes%netMassOut(i,j) = 0. + endif + enddo ; enddo + + if (CS%debug) then + call hchksum(h,"h before fluxes into ocean",G%HI) + call MOM_tracer_chkinv("Before fluxes into ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + do m = 1,CS%tracer_reg%ntr + ! Layer thicknesses should only be updated after the last tracer is finished + update_h = ( m == CS%tracer_reg%ntr ) + call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_reg%tr(m)%t, CS%dt_offline, fluxes, h, & + CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) + enddo + if (CS%debug) then + call hchksum(h,"h after fluxes into ocean",G%HI) + call MOM_tracer_chkinv("After fluxes into ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + + ! Now that fluxes into the ocean are done, save the negative fluxes for later + fluxes%netMassOut(:,:) = negative_fw(:,:) + +end subroutine offline_fw_fluxes_into_ocean + +!> Apply negative freshwater fluxes (out of the ocean) +subroutine offline_fw_fluxes_out_ocean(G, GV, CS, fluxes, h, out_flux_optional) + type(offline_transport_CS), intent(inout) :: CS !< Offline control structure + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure + type(forcing), intent(inout) :: fluxes !< Surface fluxes container + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units + !> The total time-integrated amount of tracer that leaves with freshwater + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional + + integer :: m + logical :: update_h !< Flag for whether h should be updated + + if ( present(out_flux_optional) ) & + call MOM_error(WARNING, "Negative freshwater fluxes with non-zero tracer concentration not supported yet") + + if (CS%debug) then + call hchksum(h,"h before fluxes out of ocean",G%HI) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + do m = 1, CS%tracer_reg%ntr + ! Layer thicknesses should only be updated after the last tracer is finished + update_h = ( m == CS%tracer_reg%ntr ) + call applyTracerBoundaryFluxesInOut(G, GV, CS%tracer_reg%tr(m)%t, CS%dt_offline, fluxes, h, & + CS%evap_CFL_limit, CS%minimum_forcing_depth, update_h_opt = update_h) + enddo + if (CS%debug) then + call hchksum(h,"h after fluxes out of ocean",G%HI) + call MOM_tracer_chkinv("Before fluxes out of ocean", G, h, CS%tracer_reg%Tr, CS%tracer_reg%ntr) + endif + +end subroutine offline_fw_fluxes_out_ocean + +!> When in layer mode, 3D horizontal advection using stored mass fluxes must be used. Horizontal advection is +!! done via tracer_advect, whereas the vertical component is actually handled by vertdiff in tracer_column_fns subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, eatr, ebtr, uhtr, vhtr) - type(forcing), intent(inout) :: fluxes !< pointers to forcing fields - type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type - real, intent(in) :: time_interval !< time interval - type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM + type(forcing), intent(inout) :: fluxes !< pointers to forcing fields + type(time_type), intent(in) :: Time_start !< starting time of a segment, as a time type + real, intent(in) :: time_interval !< Offline transport time interval + type(offline_transport_CS), pointer :: CS !< control structure from initialize_MOM real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_pre !< layer thicknesses before advection real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: eatr !< Entrainment from layer above real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: ebtr !< Entrainment from layer below @@ -528,13 +811,13 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! metrics and related information type(verticalGrid_type), pointer :: GV => NULL() ! Pointer to structure containing information ! about the vertical grid - ! Zonal mass transports + ! Remaining zonal mass transports real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr_sub - ! Meridional mass transports + ! Remaining meridional mass transports real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr_sub real :: sum_abs_fluxes, sum_u, sum_v ! Used to keep track of how close to convergence we are - real :: dt_offline ! Shorthand variables from offline CS + real :: dt_offline ! Local variables ! Vertical diffusion related variables @@ -579,8 +862,7 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, ! Calculate 3d mass transports to be used in this iteration - call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre, & - CS%max_off_cfl) + call limit_mass_flux_3d(G, GV, uhtr_sub, vhtr_sub, eatr_sub, ebtr_sub, h_pre) if (z_first) then ! First do vertical advection @@ -678,209 +960,101 @@ subroutine offline_advection_layer(fluxes, Time_start, time_interval, CS, h_pre, end subroutine offline_advection_layer -!> Controls the reading in 3d mass fluxes, diffusive fluxes, and other fields stored -!! in a previous integration of the online model -subroutine transport_by_files(G, GV, CS, h_end, eatr, ebtr, uhtr, vhtr, & - temp_mean, salt_mean, fluxes, do_ale_in) - - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(inout) :: GV !< The ocean's vertical grid structure - type(offline_transport_CS), intent(inout) :: CS - logical, optional :: do_ale_in - - !! Mandatory variables - ! Fields at U-points - ! 3D - ! Zonal mass transports - real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: uhtr - ! Meridional mass transports - real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)) :: vhtr - - ! Vertical diffusion related variables - real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: & - h_end, & - eatr, ebtr, & - temp_mean, salt_mean - type(forcing) :: fluxes - logical :: do_ale +!> Update fields used in this round of offline transport. First fields are updated from files or from arrays +!! read during initialization. Then if in an ALE-dependent coordinate, regrid/remap fields. +subroutine update_offline_fields(CS, h, fluxes, do_ale) + type(offline_transport_CS), pointer :: CS !< Control structure for offline module + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h !< The regridded layer thicknesses + type(forcing), intent(inout) :: fluxes !< Pointers to forcing fields + logical, intent(in ) :: do_ale !< True if using ALE + ! Local variables integer :: i, j, k, is, ie, js, je, nz - real :: Initer_vert - do_ale = .false.; - if (present(do_ale_in) ) do_ale = do_ale_in - - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = GV%ke + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)) :: h_start + is = CS%G%isc ; ie = CS%G%iec ; js = CS%G%jsc ; je = CS%G%jec ; nz = CS%GV%ke + + call cpu_clock_begin(CS%id_clock_read_fields) + call callTree_enter("update_offline_fields, MOM_offline_main.F90") + + ! Store a copy of the layer thicknesses before ALE regrid/remap + h_start(:,:,:) = h(:,:,:) + + ! Most fields will be read in from files + call update_offline_from_files( CS%G, CS%GV, CS%nk_input, CS%mean_file, CS%sum_file, CS%snap_file, CS%surf_file, & + CS%h_end, CS%uhtr, CS%vhtr, CS%tv%T, CS%tv%S, CS%mld, CS%Kd, fluxes, & + CS%ridx_sum, CS%ridx_snap, CS%read_mld, CS%read_sw, .not. CS%read_all_ts_uvh, do_ale) + ! If uh, vh, h_end, temp, salt were read in at the beginning, fields are copied from those arrays + if (CS%read_all_ts_uvh) then + call update_offline_from_arrays(CS%G, CS%GV, CS%nk_input, CS%ridx_sum, CS%mean_file, CS%sum_file, CS%snap_file, & + CS%uhtr, CS%vhtr, CS%h_end, CS%uhtr_all, CS%vhtr_all, CS%hend_all, CS%tv%T, CS%tv%S, CS%temp_all, CS%salt_all) + endif + if (CS%debug) then + call uvchksum("[uv]h after update offline from files and arrays", CS%uhtr, CS%vhtr, CS%G%HI) + endif - call callTree_enter("transport_by_files, MOM_offline_control.F90") - - uhtr(:,:,:) = 0.0 - vhtr(:,:,:) = 0.0 - eatr(:,:,:) = 0.0 - ebtr(:,:,:) = 0.0 - h_end(:,:,:) = 0.0 - temp_mean(:,:,:) = 0.0 - salt_mean(:,:,:) = 0.0 - - !! Time-summed fields - ! U-grid - call read_data(CS%sum_file, 'uhtr_sum', uhtr,domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=EAST) - ! V-grid - call read_data(CS%sum_file, 'vhtr_sum', vhtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=NORTH) - ! T-grid - call read_data(CS%sum_file, 'ea_sum', eatr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=CENTER) - call read_data(CS%sum_file, 'eb_sum', ebtr, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=CENTER) - - !! Time-averaged fields - call read_data(CS%mean_file, 'temp', temp_mean, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=CENTER) - call read_data(CS%mean_file, 'salt', salt_mean, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum,position=CENTER) - - !! Read snapshot fields (end of time interval timestamp) - call read_data(CS%snap_file, 'h_end', h_end, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_snap,position=CENTER) - - ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, - ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine + ! If using an ALE-dependent vertical coordinate, fields will need to be remapped if (do_ale) then - if (.not. ASSOCIATED(fluxes%netMassOut)) then - allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassOut(:,:) = 0.0 - endif - if (.not. ASSOCIATED(fluxes%netMassIn)) then - allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassIn(:,:) = 0.0 + ! These halo passes are necessary because u, v fields will need information 1 step into the halo + call pass_var(h, CS%G%Domain) + call pass_var(CS%tv%T, CS%G%Domain) + call pass_var(CS%tv%S, CS%G%Domain) + call ALE_offline_inputs(CS%ALE_CSp, CS%G, CS%GV, h, CS%tv, CS%tracer_Reg, CS%uhtr, CS%vhtr, CS%Kd, CS%debug) + if (CS%id_temp_regrid>0) call post_data(CS%id_temp_regrid, CS%tv%T, CS%diag) + if (CS%id_salt_regrid>0) call post_data(CS%id_salt_regrid, CS%tv%S, CS%diag) + if (CS%id_uhtr_regrid>0) call post_data(CS%id_uhtr_regrid, CS%uhtr, CS%diag) + if (CS%id_vhtr_regrid>0) call post_data(CS%id_vhtr_regrid, CS%vhtr, CS%diag) + if (CS%id_h_regrid>0) call post_data(CS%id_h_regrid, h, CS%diag) + if (CS%debug) then + call uvchksum("[uv]h after ALE regridding/remapping of inputs", CS%uhtr, CS%vhtr, CS%G%HI) + call hchksum(h_start,"h_start after update offline from files and arrays", CS%G%HI) endif - - CS%netMassOut(:,:) = 0.0 - CS%netMassIn(:,:) = 0.0 - call read_data(CS%sum_file,'massout_flux_sum',CS%netMassOut, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum) - call read_data(CS%sum_file,'massin_flux_sum', CS%netMassIn, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum) - - do j=js,je ; do i=is,ie - if(G%mask2dT(i,j)<1.0) then - CS%netMassOut(i,j) = 0.0 - CS%netMassIn(i,j) = 0.0 - endif - enddo ; enddo - endif - if (CS%read_mld) then - call read_data(CS%mean_file,'MLD', CS%mld, domain=G%Domain%mpp_domain, timelevel=CS%ridx_sum) - endif + ! Update halos for some + call pass_var(CS%h_end, CS%G%Domain) + call pass_var(CS%tv%T, CS%G%Domain) + call pass_var(CS%tv%S, CS%G%Domain) - if (CS%read_sw) then - - ! Shortwave radiation is only needed for offline mode with biogeochemistry. - ! Need to double check, but set_opacity seems to only need the sum of the diffuse and - ! direct fluxes in the visible and near-infrared bands. For convenience, we store the - ! sum of the direct and diffuse fluxes in the 'dir' field and set the 'dif' fields to zero - call read_data(CS%mean_file,'sw_vis',fluxes%sw_vis_dir, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum) - call read_data(CS%mean_file,'sw_nir',fluxes%sw_nir_dir, domain=G%Domain%mpp_domain, & - timelevel=CS%ridx_sum) - fluxes%sw_vis_dir(:,:) = fluxes%sw_vis_dir(:,:)*0.5 - fluxes%sw_vis_dif(:,:) = fluxes%sw_vis_dir - fluxes%sw_nir_dir(:,:) = fluxes%sw_nir_dir(:,:)*0.5 - fluxes%sw_nir_dif(:,:) = fluxes%sw_nir_dir - fluxes%sw = fluxes%sw_vis_dir + fluxes%sw_vis_dif + fluxes%sw_nir_dir + fluxes%sw_nir_dif - do j=js,je ; do i=is,ie - if(G%mask2dT(i,j)<1.0) then - fluxes%sw(i,j) = 0.0 - fluxes%sw_vis_dir(i,j) = 0.0 - fluxes%sw_nir_dir(i,j) = 0.0 - fluxes%sw_vis_dif(i,j) = 0.0 - fluxes%sw_nir_dif(i,j) = 0.0 - endif - enddo ; enddo - call pass_var(fluxes%sw,G%Domain) - call pass_var(fluxes%sw_vis_dir,G%Domain) - call pass_var(fluxes%sw_vis_dif,G%Domain) - call pass_var(fluxes%sw_nir_dir,G%Domain) - call pass_var(fluxes%sw_nir_dif,G%Domain) - endif + ! Update the read indices + CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) + CS%ridx_sum = next_modulo_time(CS%ridx_sum,CS%numtime) - ! Apply masks at T, U, and V points + ! Apply masks/factors at T, U, and V points do k=1,nz ; do j=js,je ; do i=is,ie - if(G%mask2dT(i,j)<1.0) then - h_end(i,j,k) = GV%Angstrom - eatr(i,j,k) = 0.0 - ebtr(i,j,k) = 0.0 - temp_mean(i,j,k) = 0.0 - salt_mean(i,j,k) = 0.0 + if (CS%G%mask2dT(i,j)<1.0) then + CS%h_end(i,j,k) = CS%GV%Angstrom endif - enddo; enddo ; enddo + do k=1,nz+1 ; do j=js,je ; do i=is,ie + CS%Kd(i,j,k) = max(0.0, CS%Kd(i,j,k)) + if (CS%Kd_max>0.) then + CS%Kd(i,j,k) = MIN(CS%Kd_max, CS%Kd(i,j,k)) + endif + enddo ; enddo ; enddo ; + do k=1,nz ; do J=js-1,je ; do i=is,ie - if(G%mask2dCv(i,J)<1.0) then - vhtr(i,J,k) = 0.0 + if (CS%G%mask2dCv(i,J)<1.0) then + CS%vhtr(i,J,k) = 0.0 endif enddo; enddo ; enddo do k=1,nz ; do j=js,je ; do I=is-1,ie - if(G%mask2dCu(I,j)<1.0) then - uhtr(I,j,k) = 0.0 + if (CS%G%mask2dCu(I,j)<1.0) then + CS%uhtr(I,j,k) = 0.0 endif enddo; enddo ; enddo - - !! Make sure all halos have been updated - ! Vector fields - call pass_vector(uhtr, vhtr, G%Domain) - - ! Scalar fields - call pass_var(h_end, G%Domain) - call pass_var(eatr, G%Domain) - call pass_var(ebtr, G%Domain) - call pass_var(temp_mean, G%Domain) - call pass_var(salt_mean, G%Domain) - - if (do_ale) then - call pass_var(CS%netMassOut,G%Domain) - call pass_var(CS%netMassIn,G%Domain) - endif - - ! Update the read indices - CS%ridx_snap = next_modulo_time(CS%ridx_snap,CS%numtime) - CS%ridx_sum = next_modulo_time(CS%ridx_sum,CS%numtime) - - if(CS%debug) then - call hchksum(h_end,"h_end after transport_by_file",G%HI) - call hchksum(eatr,"eatr after transport_by_file",G%HI) - call hchksum(ebtr,"ebtr after transport_by_file",G%HI) - call uvchksum("[uv]htr after transport_by_file", uhtr, vhtr, G%HI) + if (CS%debug) then + call uvchksum("[uv]htr_sub after update_offline_fields", CS%uhtr, CS%vhtr, CS%G%HI) + call hchksum(CS%h_end, "h_end after update_offline_fields", CS%G%HI) + call hchksum(CS%tv%T, "Temp after update_offline_fields", CS%G%HI) + call hchksum(CS%tv%S, "Salt after update_offline_fields", CS%G%HI) endif - call callTree_leave("transport_by_file") - -end subroutine transport_by_files - -!> Calculates the next timelevel to read from the input fields. This allows the 'looping' -!! of the fields -function next_modulo_time(inidx, numtime) - ! Returns the next time interval to be read - integer :: numtime ! Number of time levels in input fields - integer :: inidx ! The current time index - - integer :: read_index ! The index in the input files that corresponds - ! to the current timestep - - integer :: next_modulo_time - - read_index = mod(inidx+1,numtime) - if (read_index < 0) read_index = inidx-read_index - if (read_index == 0) read_index = numtime + call callTree_leave("update_offline_fields") + call cpu_clock_end(CS%id_clock_read_fields) - next_modulo_time = read_index - -end function next_modulo_time +end subroutine update_offline_fields !> Initialize additional diagnostics required for offline tracer transport subroutine register_diags_offline_transport(Time, diag, CS) @@ -889,44 +1063,167 @@ subroutine register_diags_offline_transport(Time, diag, CS) type(time_type), intent(in) :: Time !< current model time type(diag_ctrl) :: diag - ! U-cell fields CS%id_uhr = register_diag_field('ocean_model', 'uhr', diag%axesCuL, Time, & - 'Zonal thickness fluxes remaining at end of timestep', 'kg') + 'Zonal thickness fluxes remaining at end of advection', 'kg') CS%id_uhr_redist = register_diag_field('ocean_model', 'uhr_redist', diag%axesCuL, Time, & 'Zonal thickness fluxes to be redistributed vertically', 'kg') + CS%id_uhr_end = register_diag_field('ocean_model', 'uhr_end', diag%axesCuL, Time, & + 'Zonal thickness fluxes at end of offline step', 'kg') ! V-cell fields CS%id_vhr = register_diag_field('ocean_model', 'vhr', diag%axesCvL, Time, & - 'Meridional thickness fluxes remaining at end of timestep', 'kg') + 'Meridional thickness fluxes remaining at end of advection', 'kg') CS%id_vhr_redist = register_diag_field('ocean_model', 'vhr_redist', diag%axesCvL, Time, & 'Meridional thickness to be redistributed vertically', 'kg') + CS%id_vhr_end = register_diag_field('ocean_model', 'vhr_end', diag%axesCvL, Time, & + 'Meridional thickness at end of offline step', 'kg') ! T-cell fields - CS%id_hr = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & + CS%id_hdiff = register_diag_field('ocean_model', 'hdiff', diag%axesTL, Time, & 'Difference between the stored and calculated layer thickness', 'm') + CS%id_hr = register_diag_field('ocean_model', 'hr', diag%axesTL, Time, & + 'Layer thickness at end of offline step', 'm') CS%id_ear = register_diag_field('ocean_model', 'ear', diag%axesTL, Time, & 'Remaining thickness entrained from above', 'm') CS%id_ebr = register_diag_field('ocean_model', 'ebr', diag%axesTL, Time, & 'Remaining thickness entrained from below', 'm') - CS%id_eta_diff = register_diag_field('ocean_model','eta_diff', diag%axesT1, Time, & - 'Difference in total water column height from online and offline','m') + CS%id_eta_pre_distribute = register_diag_field('ocean_model','eta_pre_distribute', & + diag%axesT1, Time, 'Total water column height before residual transport redistribution','m') + CS%id_eta_post_distribute = register_diag_field('ocean_model','eta_post_distribute', & + diag%axesT1, Time, 'Total water column height after residual transport redistribution','m') + CS%id_eta_diff_end = register_diag_field('ocean_model','eta_diff_end', diag%axesT1, Time, & + 'Difference in total water column height from online and offline ' // & + 'at the end of the offline timestep','m') CS%id_h_redist = register_diag_field('ocean_model','h_redist', diag%axesTL, Time, & 'Layer thicknesses before redistribution of mass fluxes','m') + ! Regridded/remapped input fields + CS%id_uhtr_regrid = register_diag_field('ocean_model', 'uhtr_regrid', diag%axesCuL, Time, & + 'Zonal mass transport regridded/remapped onto offline grid','kg') + CS%id_vhtr_regrid = register_diag_field('ocean_model', 'vhtr_regrid', diag%axesCvL, Time, & + 'Meridional mass transport regridded/remapped onto offline grid','kg') + CS%id_temp_regrid = register_diag_field('ocean_model', 'temp_regrid', diag%axesTL, Time, & + 'Temperature regridded/remapped onto offline grid','C') + CS%id_salt_regrid = register_diag_field('ocean_model', 'salt_regrid', diag%axesTL, Time, & + 'Salinity regridded/remapped onto offline grid','g kg-1') + CS%id_h_regrid = register_diag_field('ocean_model', 'h_regrid', diag%axesTL, Time, & + 'Layer thicknesses regridded/remapped onto offline grid','m') + + end subroutine register_diags_offline_transport +!> Posts diagnostics related to offline convergence diagnostics +subroutine post_offline_convergence_diags(CS, h_off, h_end, uhtr, vhtr) + type(offline_transport_CS), intent(in ) :: CS !< Offline control structure + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_off !< Thicknesses at end of offline step + real, dimension(SZI_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: h_end !< Stored thicknesses + real, dimension(SZIB_(CS%G),SZJ_(CS%G),SZK_(CS%G)), intent(inout) :: uhtr !< Remaining zonal mass transport + real, dimension(SZI_(CS%G),SZJB_(CS%G),SZK_(CS%G)), intent(inout) :: vhtr !< Remaining meridional mass transport + + real, dimension(SZI_(CS%G),SZJ_(CS%G)) :: eta_diff + integer :: i, j, k + + if (CS%id_eta_diff_end>0) then + ! Calculate difference in column thickness + eta_diff = 0. + do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + eta_diff(i,j) = eta_diff(i,j) + h_off(i,j,k) + enddo ; enddo ; enddo + do k=1,CS%GV%ke ; do j=CS%G%jsc,CS%G%jec ; do i=CS%G%isc,CS%G%iec + eta_diff(i,j) = eta_diff(i,j) - h_end(i,j,k) + enddo ; enddo ; enddo + + call post_data(CS%id_eta_diff_end, eta_diff, CS%diag) + endif + + if (CS%id_hdiff>0) call post_data(CS%id_hdiff, h_off-h_end, CS%diag) + if (CS%id_hr>0) call post_data(CS%id_hr, h_off, CS%diag) + if (CS%id_uhr_end>0) call post_data(CS%id_uhr_end, uhtr, CS%diag) + if (CS%id_vhr_end>0) call post_data(CS%id_vhr_end, vhtr, CS%diag) + +end subroutine post_offline_convergence_diags + +!> Extracts members of the offline main control structure. All arguments are optional except +!! the control structure itself +subroutine extract_offline_main(CS, uhtr, vhtr, eatr, ebtr, h_end, accumulated_time, dt_offline, dt_offline_vertical, & + skip_diffusion) + type(offline_transport_CS), target, intent(in ) :: CS !< Offline control structure + ! Returned optional arguments + real, dimension(:,:,:), pointer, optional, intent( out) :: uhtr + real, dimension(:,:,:), pointer, optional, intent( out) :: vhtr + real, dimension(:,:,:), pointer, optional, intent( out) :: eatr + real, dimension(:,:,:), pointer, optional, intent( out) :: ebtr + real, dimension(:,:,:), pointer, optional, intent( out) :: h_end + integer, pointer, optional, intent( out) :: accumulated_time + integer, optional, intent( out) :: dt_offline + integer, optional, intent( out) :: dt_offline_vertical + logical, optional, intent( out) :: skip_diffusion + + ! Pointers to 3d members + if (present(uhtr)) uhtr => CS%uhtr + if (present(vhtr)) vhtr => CS%vhtr + if (present(eatr)) eatr => CS%eatr + if (present(ebtr)) ebtr => CS%ebtr + if (present(h_end)) h_end => CS%h_end + + ! Pointers to integer members which need to be modified + if (present(accumulated_time)) accumulated_time => CS%accumulated_time + + ! Return value of non-modified integers + if (present(dt_offline)) dt_offline = CS%dt_offline + if (present(dt_offline_vertical)) dt_offline_vertical = CS%dt_offline_vertical + if (present(skip_diffusion)) skip_diffusion = CS%skip_diffusion + +end subroutine extract_offline_main + +!> Inserts (assigns values to) members of the offline main control structure. All arguments +!! are optional except for the CS itself +subroutine insert_offline_main(CS, ALE_CSp, diabatic_CSp, diag, OBC, tracer_adv_CSp, & + tracer_flow_CSp, tracer_Reg, tv, G, GV, x_before_y, debug) + type(offline_transport_CS), intent(inout) :: CS + ! Inserted optional arguments + type(ALE_CS), target, optional, intent(in ) :: ALE_CSp + type(diabatic_CS), target, optional, intent(in ) :: diabatic_CSp + type(diag_ctrl), target, optional, intent(in ) :: diag + type(ocean_OBC_type), target, optional, intent(in ) :: OBC + type(tracer_advect_CS), target, optional, intent(in ) :: tracer_adv_CSp + type(tracer_flow_control_CS), target, optional, intent(in ) :: tracer_flow_CSp + type(tracer_registry_type), target, optional, intent(in ) :: tracer_Reg + type(thermo_var_ptrs), target, optional, intent(in ) :: tv + type(ocean_grid_type), target, optional, intent(in ) :: G + type(verticalGrid_type), target, optional, intent(in ) :: GV + logical, optional, intent(in ) :: x_before_y + logical, optional, intent(in ) :: debug + + + if (present(ALE_CSp)) CS%ALE_CSp => ALE_CSp + if (present(diabatic_CSp)) CS%diabatic_CSp => diabatic_CSp + if (present(diag)) CS%diag => diag + if (present(OBC)) CS%OBC => OBC + if (present(tracer_adv_CSp)) CS%tracer_adv_CSp => tracer_adv_CSp + if (present(tracer_flow_CSp)) CS%tracer_flow_CSp => tracer_flow_CSp + if (present(tracer_Reg)) CS%tracer_Reg => tracer_Reg + if (present(tv)) CS%tv => tv + if (present(G)) CS%G => G + if (present(GV)) CS%GV => GV + if (present(x_before_y)) CS%x_before_y = x_before_y + if (present(debug)) CS%debug = debug + +end subroutine insert_offline_main + !> Initializes the control structure for offline transport and reads in some of the ! run time parameters from MOM_input subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters + type(param_file_type), intent(in) :: param_file type(offline_transport_CS), pointer, intent(inout) :: CS type(diabatic_CS), pointer, intent(in) :: diabatic_CSp - type(ocean_grid_type), pointer, intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), pointer, intent(in) :: GV !< The ocean's vertical grid structure + type(ocean_grid_type), pointer, intent(in) :: G + type(verticalGrid_type), pointer, intent(in) :: GV - character(len=40) :: mod = "offline_transport" + character(len=40) :: mdl = "offline_transport" + character(len=20) :: redistribute_method integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB @@ -943,63 +1240,111 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) return endif allocate(CS) - call log_version(param_file,mod,version, & - "This module allows for tracers to be run offline") + call log_version(param_file, mdl,version, "This module allows for tracers to be run offline") ! Parse MOM_input for offline control - call get_param(param_file, mod, "OFFLINEDIR", CS%offlinedir, & - "Input directory where the offline fields can be found", default=" ") - call get_param(param_file, mod, "OFF_SUM_FILE", CS%sum_file, & - "Filename where the accumulated fields can be found", default = " ") - call get_param(param_file, mod, "OFF_SNAP_FILE", CS%snap_file, & - "Filename where snapshot fields can be found",default=" ") - call get_param(param_file, mod, "OFF_MEAN_FILE", CS%mean_file, & - "Filename where averaged fields can be found",default=" ") - call get_param(param_file, mod, "START_INDEX", CS%start_index, & + call get_param(param_file, mdl, "OFFLINEDIR", CS%offlinedir, & + "Input directory where the offline fields can be found", fail_if_missing = .true.) + call get_param(param_file, mdl, "OFF_SUM_FILE", CS%sum_file, & + "Filename where the accumulated fields can be found", fail_if_missing = .true.) + call get_param(param_file, mdl, "OFF_SNAP_FILE", CS%snap_file, & + "Filename where snapshot fields can be found", fail_if_missing = .true.) + call get_param(param_file, mdl, "OFF_MEAN_FILE", CS%mean_file, & + "Filename where averaged fields can be found", fail_if_missing = .true.) + call get_param(param_file, mdl, "OFF_SURF_FILE", CS%surf_file, & + "Filename where averaged fields can be found", fail_if_missing = .true.) + call get_param(param_file, mdl, "NUMTIME", CS%numtime, & + "Number of timelevels in offline input files", fail_if_missing = .true.) + call get_param(param_file, mdl, "NK_INPUT", CS%nk_input, & + "Number of vertical levels in offline input files", default = nz) + call get_param(param_file, mdl, "DT_OFFLINE", CS%dt_offline, & + "Length of time between reading in of input fields", fail_if_missing = .true.) + call get_param(param_file, mdl, "DT_OFFLINE_VERTICAL", CS%dt_offline_vertical, & + "Length of the offline timestep for tracer column sources/sinks\n" //& + "This should be set to the length of the coupling timestep for \n" //& + "tracers which need shortwave fluxes", fail_if_missing = .true.) + call get_param(param_file, mdl, "START_INDEX", CS%start_index, & "Which time index to start from", default=1) - call get_param(param_file, mod, "NUMTIME", CS%numtime, & - "Number of timelevels in offline input files", default=0) - call get_param(param_file, mod, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & + call get_param(param_file, mdl, "FIELDS_ARE_OFFSET", CS%fields_are_offset, & "True if the time-averaged fields and snapshot fields\n"//& "are offset by one time level", default=.false.) - call get_param(param_file, mod, "REDISTRIBUTE_METHOD", CS%redistribute_method, & - "Redistributes any remaining horizontal fluxes throughout\n"//& - "the rest of water column. Options are 'barotropic' which\n"//& - "evenly distributes flux throughout the entire water column,\n"//& - "'upwards' which adds the maximum of the remaining flux in\n"//& - "each layer above, and 'none' which does no redistribution", & + call get_param(param_file, mdl, "REDISTRIBUTE_METHOD", redistribute_method, & + "Redistributes any remaining horizontal fluxes throughout\n" //& + "the rest of water column. Options are 'barotropic' which\n" //& + "evenly distributes flux throughout the entire water column,\n" //& + "'upwards' which adds the maximum of the remaining flux in\n" //& + "each layer above, both which first applies upwards and then\n" //& + "barotropic, and 'none' which does no redistribution", & default='barotropic') - call get_param(param_file, mod, "NUM_OFF_ITER", CS%num_off_iter, & - "Number of iterations to subdivide the offline tracer advection and diffusion" ) - call get_param(param_file, mod, "DT_OFFLINE", CS%dt_offline, & - "Length of the offline timestep") - call get_param(param_file, mod, "DT_OFFLINE_VERTICAL", CS%dt_offline_vertical, & - "Length of the offline timestep for tracer column sources/sinks") - call get_param(param_file, mod, "PRINT_ADV_OFFLINE", CS%print_adv_offline, & + call get_param(param_file, mdl, "NUM_OFF_ITER", CS%num_off_iter, & + "Number of iterations to subdivide the offline tracer advection and diffusion", & + default = 60) + call get_param(param_file, mdl, "OFF_ALE_MOD", CS%off_ale_mod, & + "Sets how many horizontal advection steps are taken before an ALE\n" //& + "remapping step is done. 1 would be x->y->ALE, 2 would be" //& + "x->y->x->y->ALE", default = 1) + call get_param(param_file, mdl, "PRINT_ADV_OFFLINE", CS%print_adv_offline, & "Print diagnostic output every advection subiteration",default=.false.) - call get_param(param_file, mod, "SKIP_DIFFUSION_OFFLINE", CS%skip_diffusion, & + call get_param(param_file, mdl, "SKIP_DIFFUSION_OFFLINE", CS%skip_diffusion, & "Do not do horizontal diffusion",default=.false.) - call get_param(param_file, mod, "READ_SW", CS%read_sw, & + call get_param(param_file, mdl, "READ_SW", CS%read_sw, & "Read in shortwave radiation field instead of using values from the coupler"//& "when in offline tracer mode",default=.false.) - call get_param(param_file, mod, "READ_MLD", CS%read_mld, & + call get_param(param_file, mdl, "READ_MLD", CS%read_mld, & "Read in mixed layer depths for tracers which exchange with the atmosphere"//& "when in offline tracer mode",default=.false.) - call get_param(param_file, mod, "OFFLINE_ADD_DIURNAL_SW", CS%diurnal_sw, & - "Adds a synthetic diurnal cycle in the same way that the ice model would have"//& - "when time-averaged fields of shortwave radiation are read in", default=.true.) + call get_param(param_file, mdl, "MLD_VAR_NAME", CS%mld_var_name, & + "Name of the variable containing the depth of active mixing",& + default='ePBL_h_ML') + call get_param(param_file, mdl, "OFFLINE_ADD_DIURNAL_SW", CS%diurnal_sw, & + "Adds a synthetic diurnal cycle in the same way that the ice\n" // & + "model would have when time-averaged fields of shortwave\n" // & + "radiation are read in", default=.false.) + call get_param(param_file, mdl, "KD_MAX", CS%Kd_max, & + "The maximum permitted increment for the diapycnal \n"//& + "diffusivity from TKE-based parameterizations, or a \n"//& + "negative value for no limit.", units="m2 s-1", default=-1.0) + call get_param(param_file, mdl, "MIN_RESIDUAL_TRANSPORT", CS%min_residual, & + "How much remaining transport before the main offline advection\n"// & + "is exited. The default value corresponds to about 1 meter of\n" // & + "difference in a grid cell", default = 1.e9) + call get_param(param_file, mdl, "READ_ALL_TS_UVH", CS%read_all_ts_uvh, & + "Reads all time levels of a subset of the fields necessary to run \n" // & + "the model offline. This can require a large amount of memory\n"// & + "and will make initialization very slow. However, for offline\n"// & + "runs spanning more than a year this can reduce total I/O overhead", & + default = .false.) ! Concatenate offline directory and file names CS%snap_file = trim(CS%offlinedir)//trim(CS%snap_file) CS%mean_file = trim(CS%offlinedir)//trim(CS%mean_file) CS%sum_file = trim(CS%offlinedir)//trim(CS%sum_file) + CS%surf_file = trim(CS%offlinedir)//trim(CS%surf_file) + + CS%num_vert_iter = CS%dt_offline/CS%dt_offline_vertical + + ! Map redistribute_method onto logicals in CS + select case (redistribute_method) + case ('barotropic') + CS%redistribute_barotropic = .true. + CS%redistribute_upwards = .false. + case ('upwards') + CS%redistribute_barotropic = .false. + CS%redistribute_upwards = .true. + case ('both') + CS%redistribute_barotropic = .true. + CS%redistribute_upwards = .true. + case ('none') + CS%redistribute_barotropic = .false. + CS%redistribute_upwards = .false. + end select ! Set the accumulated time to zero CS%accumulated_time = 0 ! Set the starting read index for time-averaged and snapshotted fields CS%ridx_sum = CS%start_index - if(CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) - if(.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index + if (CS%fields_are_offset) CS%ridx_snap = next_modulo_time(CS%start_index,CS%numtime) + if (.not. CS%fields_are_offset) CS%ridx_snap = CS%start_index ! Copy members from other modules call extract_diabatic_member(diabatic_CSp, opacity_CSp=CS%opacity_CSp, optics_CSp=CS%optics,& @@ -1011,23 +1356,101 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV) CS%GV => GV ! Allocate arrays - ALLOC_(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0 - ALLOC_(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0 - ALLOC_(CS%eatr(isd:ied,jsd:jed,nz)) ; CS%eatr(:,:,:) = 0.0 - ALLOC_(CS%ebtr(isd:ied,jsd:jed,nz)) ; CS%ebtr(:,:,:) = 0.0 - ALLOC_(CS%temp_mean(isd:ied,jsd:jed,nz)) ; CS%temp_mean(:,:,:) = 0.0 - ALLOC_(CS%salt_mean(isd:ied,jsd:jed,nz)) ; CS%salt_mean(:,:,:) = 0.0 - ALLOC_(CS%h_end(isd:ied,jsd:jed,nz)) ; CS%h_end(:,:,:) = 0.0 - ALLOC_(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassOut(:,:) = 0.0 - ALLOC_(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassIn(:,:) = 0.0 + allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0 + allocate(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0 + allocate(CS%eatr(isd:ied,jsd:jed,nz)) ; CS%eatr(:,:,:) = 0.0 + allocate(CS%ebtr(isd:ied,jsd:jed,nz)) ; CS%ebtr(:,:,:) = 0.0 + allocate(CS%h_end(isd:ied,jsd:jed,nz)) ; CS%h_end(:,:,:) = 0.0 + allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassOut(:,:) = 0.0 + allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassIn(:,:) = 0.0 + allocate(CS%Kd(isd:ied,jsd:jed,nz+1)) ; CS%Kd = 0. if (CS%read_mld) then allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed)) ; CS%mld(:,:) = 0.0 endif + if (CS%read_all_ts_uvh) then + call read_all_input(CS) + endif + + ! Initialize ids for clocks used in offline routines + CS%id_clock_read_fields = cpu_clock_id('(Offline read fields)',grain=CLOCK_MODULE) + CS%id_clock_offline_diabatic = cpu_clock_id('(Offline diabatic)',grain=CLOCK_MODULE) + CS%id_clock_offline_adv = cpu_clock_id('(Offline transport)',grain=CLOCK_MODULE) + CS%id_clock_redistribute = cpu_clock_id('(Offline redistribute)',grain=CLOCK_MODULE) + call callTree_leave("offline_transport_init") end subroutine offline_transport_init +!> Coordinates the allocation and reading in all time levels of uh, vh, hend, temp, and salt from files. Used +!! when read_all_ts_uvh +subroutine read_all_input(CS) + type(offline_transport_CS), pointer, intent(inout) :: CS + + integer :: is, ie, js, je, isd, ied, jsd, jed, nz, t, ntime + integer :: IsdB, IedB, JsdB, JedB + + nz = CS%GV%ke ; ntime = CS%numtime + isd = CS%G%isd ; ied = CS%G%ied ; jsd = CS%G%jsd ; jed = CS%G%jed + IsdB = CS%G%IsdB ; IedB = CS%G%IedB ; JsdB = CS%G%JsdB ; JedB = CS%G%JedB + + ! Extra safety check that we're not going to overallocate any arrays + if (CS%read_all_ts_uvh) then + if (allocated(CS%uhtr_all)) call MOM_error(FATAL, "uhtr_all is already allocated") + if (allocated(CS%vhtr_all)) call MOM_error(FATAL, "vhtr_all is already allocated") + if (allocated(CS%hend_all)) call MOM_error(FATAL, "hend_all is already allocated") + if (allocated(CS%temp_all)) call MOM_error(FATAL, "temp_all is already allocated") + if (allocated(CS%salt_all)) call MOM_error(FATAL, "salt_all is already allocated") + + allocate(CS%uhtr_all(IsdB:IedB,jsd:jed,nz,ntime)) ; CS%uhtr_all(:,:,:,:) = 0.0 + allocate(CS%vhtr_all(isd:ied,JsdB:JedB,nz,ntime)) ; CS%vhtr_all(:,:,:,:) = 0.0 + allocate(CS%hend_all(isd:ied,jsd:jed,nz,ntime)) ; CS%hend_all(:,:,:,:) = 0.0 + allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%temp_all(:,:,:,:) = 0.0 + allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%salt_all(:,:,:,:) = 0.0 + + if (is_root_pe()) write (0,*) "Reading in uhtr, vhtr, h_start, h_end, temp, salt" + do t = 1,ntime + call read_data(CS%sum_file, 'uhtr_sum', CS%uhtr_all(:,:,1:CS%nk_input,t), domain=CS%G%Domain%mpp_domain, & + timelevel=t, position=EAST) + call read_data(CS%sum_file, 'vhtr_sum', CS%vhtr_all(:,:,1:CS%nk_input,t), domain=CS%G%Domain%mpp_domain, & + timelevel=t, position=NORTH) + call read_data(CS%snap_file,'h_end', CS%hend_all(:,:,1:CS%nk_input,t), domain=CS%G%Domain%mpp_domain, & + timelevel=t, position=CENTER) + call read_data(CS%mean_file,'temp', CS%temp_all(:,:,1:CS%nk_input,t), domain=CS%G%Domain%mpp_domain, & + timelevel=t, position=CENTER) + call read_data(CS%mean_file,'salt', CS%salt_all(:,:,1:CS%nk_input,t), domain=CS%G%Domain%mpp_domain, & + timelevel=t, position=CENTER) + enddo + endif + +end subroutine read_all_input + +!> Deallocates (if necessary) arrays within the offline control structure +subroutine offline_transport_end(CS) + type(offline_transport_CS), pointer, intent(inout) :: CS + + ! Explicitly allocate all allocatable arrays + deallocate(CS%uhtr) + deallocate(CS%vhtr) + deallocate(CS%eatr) + deallocate(CS%ebtr) + deallocate(CS%h_end) + deallocate(CS%netMassOut) + deallocate(CS%netMassIn) + deallocate(CS%Kd) + if (CS%read_mld) deallocate(CS%mld) + if (CS%read_all_ts_uvh) then + deallocate(CS%uhtr_all) + deallocate(CS%vhtr_all) + deallocate(CS%hend_all) + deallocate(CS%temp_all) + deallocate(CS%salt_all) + endif + + deallocate(CS) + +end subroutine offline_transport_end + !> \namespace mom_offline_main !! \section offline_overview Offline Tracer Transport in MOM6 !! 'Offline tracer modeling' uses physical fields (e.g. mass transports and layer thicknesses) saved @@ -1108,3 +1531,4 @@ end subroutine offline_transport_init !! and 'none' which does no redistribution" end module MOM_offline_main + diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 476cb5d512..931e732bc7 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -79,7 +79,7 @@ function tracer_Z_init(tr, h, filename, tr_name, G, missing_val, land_val) integer, save :: init_calls = 0 ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_tracer_Z_init" ! This module's name. + character(len=40) :: mdl = "MOM_tracer_Z_init" ! This module's name. character(len=256) :: mesg ! Message for error messages. real, allocatable, dimension(:,:,:) :: & @@ -327,33 +327,33 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & ! missing value, and if so return true. ! (inout) missing - The missing value, if one has been found. - character(len=32) :: mod + character(len=32) :: mdl character(len=120) :: dim_name, edge_name, tr_msg, dim_msg logical :: monotonic integer :: ncid, status, intid, tr_id, layid, k integer :: nz_edge, ndim, tr_dim_ids(NF90_MAX_VAR_DIMS) - mod = "MOM_tracer_Z_init read_Z_edges: " + mdl = "MOM_tracer_Z_init read_Z_edges: " tr_msg = trim(tr_name)//" in "//trim(filename) status = NF90_OPEN(filename, NF90_NOWRITE, ncid); if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties opening "//trim(filename)//& + call MOM_error(WARNING,mdl//" Difficulties opening "//trim(filename)//& " - "//trim(NF90_STRERROR(status))) nz_out = -1 ; return endif status = NF90_INQ_VARID(ncid, tr_name, tr_id) if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties finding variable "//& + call MOM_error(WARNING,mdl//" Difficulties finding variable "//& trim(tr_msg)//" - "//trim(NF90_STRERROR(status))) nz_out = -1 ; status = NF90_CLOSE(ncid) ; return endif status = NF90_INQUIRE_VARIABLE(ncid, tr_id, ndims=ndim, dimids=tr_dim_ids) if (status /= NF90_NOERR) then - call MOM_ERROR(WARNING,mod//" cannot inquire about "//trim(tr_msg)) + call MOM_ERROR(WARNING,mdl//" cannot inquire about "//trim(tr_msg)) elseif ((ndim < 3) .or. (ndim > 4)) then - call MOM_ERROR(WARNING,mod//" "//trim(tr_msg)//& + call MOM_ERROR(WARNING,mdl//" "//trim(tr_msg)//& " has too many or too few dimensions.") nz_out = -1 ; status = NF90_CLOSE(ncid) ; return endif @@ -367,28 +367,28 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & ! Get the axis name and length. status = NF90_INQUIRE_DIMENSION(ncid, tr_dim_ids(3), dim_name, len=nz_out) if (status /= NF90_NOERR) then - call MOM_ERROR(WARNING,mod//" cannot inquire about dimension(3) of "//& + call MOM_ERROR(WARNING,mdl//" cannot inquire about dimension(3) of "//& trim(tr_msg)) endif dim_msg = trim(dim_name)//" in "//trim(filename) status = NF90_INQ_VARID(ncid, dim_name, layid) if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties finding variable "//& + call MOM_error(WARNING,mdl//" Difficulties finding variable "//& trim(dim_msg)//" - "//trim(NF90_STRERROR(status))) nz_out = -1 ; status = NF90_CLOSE(ncid) ; return endif ! Find out if the Z-axis has an edges attribute status = NF90_GET_ATT(ncid, layid, "edges", edge_name) if (status /= NF90_NOERR) then - call MOM_mesg(mod//" "//trim(dim_msg)//& + call MOM_mesg(mdl//" "//trim(dim_msg)//& " has no readable edges attribute - "//trim(NF90_STRERROR(status))) has_edges = .false. else has_edges = .true. status = NF90_INQ_VARID(ncid, edge_name, intid) if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties finding edge variable "//& + call MOM_error(WARNING,mdl//" Difficulties finding edge variable "//& trim(edge_name)//" in "//trim(filename)//" - "//trim(NF90_STRERROR(status))) has_edges = .false. endif @@ -404,21 +404,21 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & dim_msg = trim(edge_name)//" in "//trim(filename) status = NF90_GET_VAR(ncid, intid, z_edges) if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties reading variable "//& + call MOM_error(WARNING,mdl//" Difficulties reading variable "//& trim(dim_msg)//" - "//trim(NF90_STRERROR(status))) nz_out = -1 ; status = NF90_CLOSE(ncid) ; return endif else status = NF90_GET_VAR(ncid, layid, z_edges) if (status /= NF90_NOERR) then - call MOM_error(WARNING,mod//" Difficulties reading variable "//& + call MOM_error(WARNING,mdl//" Difficulties reading variable "//& trim(dim_msg)//" - "//trim(NF90_STRERROR(status))) nz_out = -1 ; status = NF90_CLOSE(ncid) ; return endif endif status = NF90_CLOSE(ncid) - if (status /= NF90_NOERR) call MOM_error(WARNING, mod// & + if (status /= NF90_NOERR) call MOM_error(WARNING, mdl// & " Difficulties closing "//trim(filename)//" - "//trim(NF90_STRERROR(status))) ! z_edges should be montonically decreasing with our sign convention. @@ -430,7 +430,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & monotonic = .true. do k=2,nz_edge ; if (z_edges(k) >= z_edges(k-1)) monotonic = .false. ; enddo if (.not.monotonic) & - call MOM_error(WARNING,mod//" "//trim(dim_msg)//" is not monotonic.") + call MOM_error(WARNING,mdl//" "//trim(dim_msg)//" is not monotonic.") end subroutine read_Z_edges diff --git a/src/tracer/MOM_tracer_advect.F90 b/src/tracer/MOM_tracer_advect.F90 index 1ff9d56677..3bd4569b53 100644 --- a/src/tracer/MOM_tracer_advect.F90 +++ b/src/tracer/MOM_tracer_advect.F90 @@ -865,7 +865,7 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_tracer_advect" ! This module's name. + character(len=40) :: mdl = "MOM_tracer_advect" ! This module's name. character(len=256) :: mesg ! Message for error messages. if (associated(CS)) then @@ -877,11 +877,11 @@ subroutine tracer_advect_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DT", CS%dt, fail_if_missing=.true., & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DT", CS%dt, fail_if_missing=.true., & desc="The (baroclinic) dynamics time step.", units="s") - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false.) - call get_param(param_file, mod, "TRACER_ADVECTION_SCHEME", mesg, & + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "TRACER_ADVECTION_SCHEME", mesg, & desc="The horizontal transport scheme for tracers:\n"//& " PLM - Piecewise Linear Method\n"//& " PPM:H3 - Piecewise Parabolic Method (Huyhn 3rd order)\n"// & diff --git a/src/tracer/MOM_tracer_diabatic.F90 b/src/tracer/MOM_tracer_diabatic.F90 index 6cf02565f8..a99ad392a9 100644 --- a/src/tracer/MOM_tracer_diabatic.F90 +++ b/src/tracer/MOM_tracer_diabatic.F90 @@ -206,24 +206,27 @@ subroutine tracer_vertdiff(h_old, ea, eb, dt, tr, G, GV, & end subroutine tracer_vertdiff -subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, & - evap_CFL_limit, minimum_forcing_depth, in_flux_optional, out_flux_optional) -! This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 -! NOTE: Please note that in this routine sfc_flux gets set to zero to ensure that the surface -! flux of the tracer does not get applied again during a subsequent call to tracer_vertdif - - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< ocean vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell - real, intent(in) :: dt !< Time-step over which forcing is applied (s) - type(forcing), intent(in) :: fluxes !< Surface fluxes container - real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units - real, intent(in) :: evap_CFL_limit - real, intent(in) :: minimum_forcing_depth - real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: in_flux_optional ! The total time-integrated amount of tracer! +!> This routine is modeled after applyBoundaryFluxesInOut in MOM_diabatic_aux.F90 +!! NOTE: Please note that in this routine sfc_flux gets set to zero to ensure that the surface +!! flux of the tracer does not get applied again during a subsequent call to tracer_vertdif +subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, evap_CFL_limit, minimum_forcing_depth, & + in_flux_optional, out_flux_optional, update_h_opt) + + type(ocean_grid_type), intent(in ) :: G !< Grid structure + type(verticalGrid_type), intent(in ) :: GV !< ocean vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: Tr !< Tracer concentration on T-cell + real, intent(in ) :: dt !< Time-step over which forcing is applied (s) + type(forcing), intent(in ) :: fluxes !< Surface fluxes container + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(inout) :: h !< Layer thickness in H units + real, intent(in ) :: evap_CFL_limit + real, intent(in ) :: minimum_forcing_depth + real, dimension(SZI_(G),SZJ_(G)), optional, intent(in ) :: in_flux_optional ! The total time-integrated amount of tracer! ! that enters with freshwater real, dimension(SZI_(G),SZJ_(G)), optional, intent(in) :: out_flux_optional ! The total time-integrated amount of tracer! ! that leaves with freshwater + !< Optional flag to determine whether h should be updated + logical, optional, intent(in) :: update_h_opt + integer, parameter :: maxGroundings = 5 integer :: numberOfGroundings, iGround(maxGroundings), jGround(maxGroundings) real :: H_limit_fluxes, IforcingDepthScale, Idt @@ -243,6 +246,7 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, & real, dimension(SZI_(G)) :: in_flux_1d, out_flux_1d real :: hGrounding(maxGroundings) real :: Tr_in + logical :: update_h integer :: i, j, is, ie, js, je, k, nz, n, nsw character(len=45) :: mesg @@ -263,12 +267,18 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, & enddo ; enddo endif + if (present(update_h_opt)) then + update_h = update_h_opt + else + update_h = .true. + endif + Idt = 1.0/dt numberOfGroundings = 0 !$OMP parallel do default(none) shared(is,ie,js,je,nz,h,Tr,G,GV,fluxes,dt, & !$OMP IforcingDepthScale,minimum_forcing_depth, & -!$OMP numberOfGroundings,iGround,jGround, & +!$OMP numberOfGroundings,iGround,jGround,update_h, & !$OMP in_flux,out_flux,hGrounding,Idt,evap_CFL_limit) & !$OMP private(h2d,Tr2d,netMassInOut,netMassOut, & !$OMP in_flux_1d,out_flux_1d,fractionOfForcing, & @@ -388,9 +398,14 @@ subroutine applyTracerBoundaryFluxesInOut(G, GV, Tr, dt, fluxes, h, & ! Step C/ copy updated tracer concentration from the 2d slice now back into model state. do k=1,nz ; do i=is,ie Tr(i,j,k) = Tr2d(i,k) - h(i,j,k) = h2d(i,k) enddo ; enddo + if (update_h) then + do k=1,nz ; do i=is,ie + h(i,j,k) = h2d(i,k) + enddo ; enddo + endif + enddo ! j-loop finish if (numberOfGroundings>0) then diff --git a/src/tracer/MOM_tracer_flow_control.F90 b/src/tracer/MOM_tracer_flow_control.F90 index c2e889266b..7c54563dcd 100644 --- a/src/tracer/MOM_tracer_flow_control.F90 +++ b/src/tracer/MOM_tracer_flow_control.F90 @@ -119,17 +119,21 @@ module MOM_tracer_flow_control contains -! The following 5 subroutines and associated definitions provide the -! machinery to register and call the subroutines that initialize -! tracers and apply vertical column processes to tracers. - +!> The following 5 subroutines and associated definitions provide the +!! machinery to register and call the subroutines that initialize +!! tracers and apply vertical column processes to tracers. subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) - type(hor_index_type), intent(in) :: HI - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(tracer_flow_control_CS), pointer :: CS - type(tracer_registry_type), pointer :: tr_Reg - type(MOM_restart_CS), pointer :: restart_CS + type(hor_index_type), intent(in) :: HI !< A horizontal index type structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time + !! parameters. + type(tracer_flow_control_CS), pointer :: CS !< A pointer that is set to point to the + !! control structure for this module. + type(tracer_registry_type), pointer :: tr_Reg !< A pointer that is set to point to the + !! control structure for the tracer + !! advection and diffusion module. + type(MOM_restart_CS), pointer :: restart_CS !< A pointer to the restart control + !! structure. ! Arguments: HI - A horizontal index type structure. ! (in) GV - The ocean's vertical grid structure. ! (in) param_file - A structure indicating the open file to parse for @@ -142,7 +146,7 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_tracer_flow_control" ! This module's name. + character(len=40) :: mdl = "MOM_tracer_flow_control" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "call_tracer_register called with an associated "// & @@ -151,41 +155,41 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) else ; allocate(CS) ; endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "USE_USER_TRACER_EXAMPLE", & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "USE_USER_TRACER_EXAMPLE", & CS%use_USER_tracer_example, & "If true, use the USER_tracer_example tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_DOME_TRACER", CS%use_DOME_tracer, & + call get_param(param_file, mdl, "USE_DOME_TRACER", CS%use_DOME_tracer, & "If true, use the DOME_tracer tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_ISOMIP_TRACER", CS%use_ISOMIP_tracer, & + call get_param(param_file, mdl, "USE_ISOMIP_TRACER", CS%use_ISOMIP_tracer, & "If true, use the ISOMIP_tracer tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_IDEAL_AGE_TRACER", CS%use_ideal_age, & + 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, mod, "USE_REGIONAL_DYES", CS%use_regional_dyes, & + call get_param(param_file, mdl, "USE_REGIONAL_DYES", CS%use_regional_dyes, & "If true, use the regional_dyes tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_OIL_TRACER", CS%use_oil, & + call get_param(param_file, mdl, "USE_OIL_TRACER", CS%use_oil, & "If true, use the oil_tracer tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_ADVECTION_TEST_TRACER", CS%use_advection_test_tracer, & + call get_param(param_file, mdl, "USE_ADVECTION_TEST_TRACER", CS%use_advection_test_tracer, & "If true, use the advection_test_tracer tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_OCMIP2_CFC", CS%use_OCMIP2_CFC, & + call get_param(param_file, mdl, "USE_OCMIP2_CFC", CS%use_OCMIP2_CFC, & "If true, use the MOM_OCMIP2_CFC tracer package.", & default=.false.) - call get_param(param_file, mod, "USE_generic_tracer", & + call get_param(param_file, mdl, "USE_generic_tracer", & CS%use_MOM_generic_tracer, & "If true and _USE_GENERIC_TRACER is defined as a \n"//& "preprocessor macro, use the MOM_generic_tracer packages.", & default=.false.) - call get_param(param_file, mod, "USE_PSEUDO_SALT_TRACER", CS%use_pseudo_salt_tracer, & + call get_param(param_file, mdl, "USE_PSEUDO_SALT_TRACER", CS%use_pseudo_salt_tracer, & "If true, use the pseudo salt tracer, typically run as a diagnostic.", & default=.false.) - call get_param(param_file, mod, "USE_BOUNDARY_IMPULSE_TRACER", CS%use_boundary_impulse_tracer, & + call get_param(param_file, mdl, "USE_BOUNDARY_IMPULSE_TRACER", CS%use_boundary_impulse_tracer, & "If true, use the boundary impulse tracer.", & default=.false.) @@ -236,21 +240,39 @@ subroutine call_tracer_register(HI, GV, param_file, CS, tr_Reg, restart_CS) end subroutine call_tracer_register +!> This subroutine calls all registered tracer initialization +!! subroutines. subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OBC, & CS, sponge_CSp, ALE_sponge_CSp, diag_to_Z_CSp, tv) - logical, intent(in) :: restart - type(time_type), target, intent(in) :: day - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(in) :: diag - type(ocean_OBC_type), pointer :: OBC - type(tracer_flow_control_CS), pointer :: CS - type(sponge_CS), pointer :: sponge_CSp - type(ALE_sponge_CS), pointer :: ALE_sponge_CSp - type(diag_to_Z_CS), pointer :: diag_to_Z_CSp - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables + logical, intent(in) :: restart !< 1 if the fields have already + !! been read from a restart file. + type(time_type), target, intent(in) :: day !< Time of the start of the run. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid + !! structure. + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2) + type(param_file_type), intent(in) :: param_file !< A structure to parse for + !! run-time parameters + type(diag_ctrl), target, intent(in) :: diag !< A structure that is used to + !! regulate diagnostic output. + type(ocean_OBC_type), pointer :: OBC !< This open boundary condition + !! type specifies whether, where, + !! and what open boundary + !! conditions are used. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! call_tracer_register. + type(sponge_CS), pointer :: sponge_CSp !< A pointer to the control + !! structure for the sponges, if they are in use. + !! Otherwise this may be unassociated. + type(ALE_sponge_CS), pointer :: ALE_sponge_CSp !< A pointer to the control + !! structure for the ALE sponges, if they are in use. + !! Otherwise this may be unassociated. + type(diag_to_Z_CS), pointer :: diag_to_Z_CSp !< A pointer to the control + !! structure for diagnostics in depth space. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables ! This subroutine calls all registered tracer initialization ! subroutines. @@ -267,7 +289,8 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB ! call_tracer_register. ! (in/out) sponge_CSp - A pointer to the control structure for the sponges, if ! they are in use. Otherwise this may be unassociated. -! (in/out) ALE_sponge_CSp - A pointer to the control structure for the ALE sponges, if they are in use. Otherwise this may be unassociated. +! (in/out) ALE_sponge_CSp - A pointer to the control structure for the ALE sponges, if they are +! in use. Otherwise this may be unassociated. ! (in/out) diag_to_Z_Csp - A pointer to the control structure for diagnostics ! in depth space. if (.not. associated(CS)) call MOM_error(FATAL, "tracer_flow_control_init: "// & @@ -312,10 +335,16 @@ subroutine tracer_flow_control_init(restart, day, G, GV, h, param_file, diag, OB end subroutine tracer_flow_control_init +! #@# This subroutine needs a doxygen description subroutine get_chl_from_model(Chl_array, G, CS) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(out) :: Chl_array - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(tracer_flow_control_CS), pointer :: CS + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(out) :: Chl_array !< The array into which the + !! model's Chlorophyll-A + !! concentrations in mg m-3 are + !! to be read. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned + !! by a previous call to + !! call_tracer_register. ! Arguments: Chl_array - The array into which the model's Chlorophyll-A ! concentrations in mg m-3 are to be read. ! (in) G - The ocean's grid structure. @@ -339,14 +368,23 @@ subroutine get_chl_from_model(Chl_array, G, CS) end subroutine get_chl_from_model +!> This subroutine calls the individual tracer modules' subroutines to +!! specify or read quantities related to their surface forcing. subroutine call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS) - type(surface), intent(inout) :: state - type(forcing), intent(inout) :: fluxes - type(time_type), intent(in) :: day_start - type(time_type), intent(in) :: day_interval - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(tracer_flow_control_CS), pointer :: CS + type(surface), intent(inout) :: state !< A structure containing fields that + !! describe the surface state of the + !! ocean. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to any + !! possible forcing fields. Unused fields + !! have NULL ptrs. + type(time_type), intent(in) :: day_start !< Start time of the fluxes. + type(time_type), intent(in) :: day_interval !< Length of time over which these + !! fluxes will be applied. + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a + !! previous call to call_tracer_register. + ! This subroutine calls the individual tracer modules' subroutines to ! specify or read quantities related to their surface forcing. ! Arguments: state - A structure containing fields that describe the @@ -368,20 +406,44 @@ subroutine call_tracer_set_forcing(state, fluxes, day_start, day_interval, G, CS end subroutine call_tracer_set_forcing +!> This subroutine calls all registered tracer column physics +!! subroutines. subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, tv, optics, CS, & debug, evap_CFL_limit, minimum_forcing_depth) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old, h_new, ea, eb - type(forcing), intent(in) :: fluxes - real, dimension(NIMEM_,NJMEM_), intent(in) :: Hml !< Mixed layer depth (m) - real, intent(in) :: dt !< The amount of time covered by this call, in 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 - type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various thermodynamic variables - type(optics_type), pointer :: optics - type(tracer_flow_control_CS), pointer :: CS - logical, intent(in) :: debug - real, optional,intent(in) :: evap_CFL_limit - real, optional,intent(in) :: minimum_forcing_depth + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_old !< Layer thickness before entrainment, + !! in m (Boussinesq) or kg m-2 + !! (non-Boussinesq). + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h_new !< Layer thickness after entrainment, + !! in m or kg m-2. + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: ea !< an array to which the amount of + !! fluid entrained from the layer above during this call + !! will be added, in m or kg m-2, the same as h_old. + real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: eb !< an array to which the amount of + !! fluid entrained from the layer below during this call + !! will be added, in m or kg m-2, the same as h_old. + type(forcing), intent(in) :: fluxes !< A structure containing pointers to + !! any possible forcing fields. + !! Unused fields have NULL ptrs. + real, dimension(NIMEM_,NJMEM_), intent(in) :: Hml !< Mixed layer depth (m) + real, intent(in) :: dt !< The amount of time covered by this + !! call, in 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. + type(thermo_var_ptrs), intent(in) :: tv !< A structure pointing to various + !! thermodynamic variables. + type(optics_type), pointer :: optics !< The structure containing optical + !! properties. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by + !! a previous call to + !! call_tracer_register. + logical, intent(in) :: debug !< Calculates checksums + real, optional,intent(in) :: evap_CFL_limit !< Limits how much water + !! can be fluxed out of the top layer + !! Stored previously in diabatic] CS. + real, optional,intent(in) :: minimum_forcing_depth !< The smallest depth + !! over which fluxes can be applied + !! Stored previously in diabatic CS. ! This subroutine calls all registered tracer column physics ! subroutines. @@ -517,21 +579,39 @@ subroutine call_tracer_column_fns(h_old, h_new, ea, eb, fluxes, Hml, dt, G, GV, end subroutine call_tracer_column_fns - +!> This subroutine calls all registered tracer packages to enable them to +!! add to the surface state returned to the coupler. These routines are optional. subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_units, & - num_stocks, stock_index, got_min_max,global_min, global_max,xgmin, ygmin, zgmin, xgmax, ygmax, zgmax) - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - real, dimension(:), intent(out) :: stock_values - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure - type(tracer_flow_control_CS), pointer :: CS - character(len=*), dimension(:), optional, intent(out) :: stock_names - character(len=*), dimension(:), optional, intent(out) :: stock_units - integer, optional, intent(out) :: num_stocks - integer, optional, intent(in) :: stock_index - logical, dimension(:), optional, intent(inout) :: got_min_max - real, dimension(:), optional, intent(out) :: global_min, global_max - real, dimension(:), optional, intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax + num_stocks, stock_index, got_min_max,global_min, global_max,xgmin, & + ygmin, zgmin, xgmax, ygmax, zgmax) + real, dimension(NIMEM_,NJMEM_,NKMEM_), & + intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + real, dimension(:), intent(out) :: stock_values + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a + !! previous call to + !! call_tracer_register. + character(len=*), dimension(:), optional, & + intent(out) :: stock_names !< Diagnostic names to use for each + !! stock. + character(len=*), dimension(:), optional, & + intent(out) :: stock_units !< Units to use in the metadata for + !! each stock. + integer, optional, & + intent(out) :: num_stocks !< The number of tracer stocks being + !! returned. + integer, optional, & + intent(in) :: stock_index !< The integer stock index from + !! stocks_constans_mod of the stock to be returned. If this is + !! present and greater than 0, only a single stock can be returned. + logical, dimension(:), optional, & + intent(inout) :: got_min_max + real, dimension(:), optional, & + intent(out) :: global_min, global_max + real, dimension(:), optional, & + intent(out) :: xgmin, ygmin, zgmin, xgmax, ygmax, zgmax ! This subroutine calls all registered tracer packages to enable them to ! add to the surface state returned to the coupler. These routines are optional. @@ -638,6 +718,7 @@ subroutine call_tracer_stocks(h, stock_values, G, GV, CS, stock_names, stock_uni end subroutine call_tracer_stocks +!> This routine stores the stocks and does error handling for call_tracer_stocks. subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, & set_pkg_name, max_ns, ns_tot, stock_names, stock_units) character(len=*), intent(in) :: pkg_name @@ -686,11 +767,17 @@ subroutine store_stocks(pkg_name, ns, names, units, values, index, stock_values, end subroutine store_stocks +!> This subroutine calls all registered tracer packages to enable them to +!! add to the surface state returned to the coupler. These routines are optional. subroutine call_tracer_surface_state(state, h, G, CS) - type(surface), intent(inout) :: state - real, dimension(NIMEM_,NJMEM_,NKMEM_), intent(in) :: h !< Layer thicknesses, in H (usually m or kg m-2) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure - type(tracer_flow_control_CS), pointer :: CS + type(surface), intent(inout) :: state !< A structure containing fields that + !! describe the surface state of the ocean. + real, dimension(NIMEM_,NJMEM_,NKMEM_), & + intent(in) :: h !< Layer thicknesses, in H + !! (usually m or kg m-2). + type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. + type(tracer_flow_control_CS), pointer :: CS !< The control structure returned by a + !! previous call to call_tracer_register. ! This subroutine calls all registered tracer packages to enable them to ! add to the surface state returned to the coupler. These routines are optional. diff --git a/src/tracer/MOM_tracer_hor_diff.F90 b/src/tracer/MOM_tracer_hor_diff.F90 index acffedcc73..0fd5d697f8 100644 --- a/src/tracer/MOM_tracer_hor_diff.F90 +++ b/src/tracer/MOM_tracer_hor_diff.F90 @@ -127,7 +127,7 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla Kh_v ! Tracer mixing coefficient at u-points, in m2 s-1. real :: max_CFL ! The global maximum of the diffusive CFL number. - logical :: use_VarMix, Resoln_scaled, do_online + logical :: use_VarMix, Resoln_scaled, do_online, use_Eady integer :: i, j, k, m, is, ie, js, je, nz, ntr, itt, num_itts real :: I_numitts ! The inverse of the number of iterations, num_itts. real :: scale ! The fraction of khdt_x or khdt_y that is applied in this @@ -171,10 +171,11 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (CS%debug) call MOM_tracer_chksum("Before tracer diffusion ", Reg%Tr, ntr, G) - use_VarMix = .false. ; Resoln_scaled = .false. + use_VarMix = .false. ; Resoln_scaled = .false. ; use_Eady = .false. if (Associated(VarMix)) then use_VarMix = VarMix%use_variable_mixing Resoln_scaled = VarMix%Resoln_scaled_KhTr + use_Eady = CS%KhTr_Slope_Cff > 0. endif call cpu_clock_begin(id_clock_pass) @@ -188,11 +189,12 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla if (do_online) then if (use_VarMix) then !$OMP parallel default(none) shared(is,ie,js,je,CS,VarMix,MEKE,Resoln_scaled, & - !$OMP Kh_u,Kh_v,khdt_x,dt,G,khdt_y) & + !$OMP Kh_u,Kh_v,khdt_x,dt,G,khdt_y,use_Eady) & !$OMP private(Kh_loc,Rd_dx) !$OMP do do j=js,je ; do I=is-1,ie - Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) + Kh_loc = CS%KhTr + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2u(I,j)*VarMix%SN_u(I,j) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i+1,j)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -208,7 +210,8 @@ subroutine tracer_hordiff(h, dt, MEKE, VarMix, G, GV, CS, Reg, tv, do_online_fla enddo ; enddo !$OMP do do J=js-1,je ; do i=is,ie - Kh_loc = CS%KhTr + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) + Kh_loc = CS%KhTr + if (use_Eady) Kh_loc = Kh_loc + CS%KhTr_Slope_Cff*VarMix%L2v(i,J)*VarMix%SN_v(i,J) if (associated(MEKE%Kh)) & Kh_Loc = Kh_Loc + MEKE%KhTr_fac*sqrt(MEKE%Kh(i,j)*MEKE%Kh(i,j+1)) if (CS%KhTr_max > 0.) Kh_loc = min(Kh_loc, CS%KhTr_max) @@ -1344,7 +1347,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, CS, CSnd) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_tracer_hor_diff" ! This module's name. + character(len=40) :: mdl = "MOM_tracer_hor_diff" ! This module's name. character(len=256) :: mesg ! Message for error messages. if (associated(CS)) then @@ -1357,45 +1360,45 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, CS, CSnd) CS%show_call_tree = callTree_showQuery() ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "KHTR", CS%KhTr, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "KHTR", CS%KhTr, & "The background along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & + call get_param(param_file, mdl, "KHTR_SLOPE_CFF", CS%KhTr_Slope_Cff, & "The scaling coefficient for along-isopycnal tracer \n"//& "diffusivity using a shear-based (Visbeck-like) \n"//& "parameterization. A non-zero value enables this param.", & units="nondim", default=0.0) - call get_param(param_file, mod, "KHTR_MIN", CS%KhTr_Min, & + call get_param(param_file, mdl, "KHTR_MIN", CS%KhTr_Min, & "The minimum along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTR_MAX", CS%KhTr_Max, & + call get_param(param_file, mdl, "KHTR_MAX", CS%KhTr_Max, & "The maximum along-isopycnal tracer diffusivity.", & units="m2 s-1", default=0.0) - call get_param(param_file, mod, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & + call get_param(param_file, mdl, "KHTR_PASSIVITY_COEFF", CS%KhTr_passivity_coeff, & "The coefficient that scales deformation radius over \n"//& "grid-spacing in passivity, where passiviity is the ratio \n"//& "between along isopycnal mxiing of tracers to thickness mixing. \n"//& "A non-zero value enables this parameterization.", & units="nondim", default=0.0) - call get_param(param_file, mod, "KHTR_PASSIVITY_MIN", CS%KhTr_passivity_min, & + call get_param(param_file, mdl, "KHTR_PASSIVITY_MIN", CS%KhTr_passivity_min, & "The minimum passivity which is the ratio between \n"//& "along isopycnal mxiing of tracers to thickness mixing. \n", & units="nondim", default=0.5) - call get_param(param_file, mod, "DT", CS%dt, fail_if_missing=.true., & + call get_param(param_file, mdl, "DT", CS%dt, fail_if_missing=.true., & desc="The (baroclinic) dynamics time step.", units="s") - call get_param(param_file, mod, "DIFFUSE_ML_TO_INTERIOR", CS%Diffuse_ML_interior, & + call get_param(param_file, mdl, "DIFFUSE_ML_TO_INTERIOR", CS%Diffuse_ML_interior, & "If true, enable epipycnal mixing between the surface \n"//& "boundary layer and the interior.", default=.false.) - call get_param(param_file, mod, "CHECK_DIFFUSIVE_CFL", CS%check_diffusive_CFL, & + call get_param(param_file, mdl, "CHECK_DIFFUSIVE_CFL", CS%check_diffusive_CFL, & "If true, use enough iterations the diffusion to ensure \n"//& "that the diffusive equivalent of the CFL limit is not \n"//& "violated. If false, always use 1 iteration.", default=.false.) CS%ML_KhTR_scale = 1.0 if (CS%Diffuse_ML_interior) then - call get_param(param_file, mod, "ML_KHTR_SCALE", CS%ML_KhTR_scale, & + call get_param(param_file, mdl, "ML_KHTR_SCALE", CS%ML_KhTR_scale, & "With Diffuse_ML_interior, the ratio of the truly \n"//& "horizontal diffusivity in the mixed layer to the \n"//& "epipycnal diffusivity. The valid range is 0 to 1.", & @@ -1407,7 +1410,7 @@ subroutine tracer_hor_diff_init(Time, G, param_file, diag, CS, CSnd) if (CS%use_neutral_diffusion .and. CS%Diffuse_ML_interior) call MOM_error(FATAL, "MOM_tracer_hor_diff: "// & "USE_NEUTRAL_DIFFUSION and DIFFUSE_ML_TO_INTERIOR are mutually exclusive!") - call get_param(param_file, mod, "DEBUG", CS%debug, default=.false.) + call get_param(param_file, mdl, "DEBUG", CS%debug, default=.false.) id_clock_diffuse = cpu_clock_id('(Ocean diffuse tracer)', grain=CLOCK_MODULE) id_clock_epimix = cpu_clock_id('(Ocean epipycnal diffuse tracer)',grain=CLOCK_MODULE) diff --git a/src/tracer/MOM_tracer_registry.F90 b/src/tracer/MOM_tracer_registry.F90 index e6365deadd..4bb981d6cd 100644 --- a/src/tracer/MOM_tracer_registry.F90 +++ b/src/tracer/MOM_tracer_registry.F90 @@ -7,6 +7,7 @@ module MOM_tracer_registry ! This file is part of MOM6. See LICENSE.md for the license. ! use MOM_diag_mediator, only : diag_ctrl +use MOM_coms, only : reproducing_sum use MOM_debugging, only : hchksum use MOM_error_handler, only : MOM_error, FATAL, WARNING, MOM_mesg, is_root_pe use MOM_file_parser, only : get_param, log_version, param_file_type @@ -23,6 +24,7 @@ module MOM_tracer_registry public register_tracer public tracer_registry_init public MOM_tracer_chksum +public MOM_tracer_chkinv public add_tracer_diagnostics public add_tracer_OBC_values public lock_tracer_registry @@ -246,22 +248,46 @@ subroutine add_tracer_diagnostics(name, Reg, ad_x, ad_y, df_x, df_y, & end subroutine add_tracer_diagnostics -!> This subroutine writes out chksums for thermodynamic state variables. +!> This subroutine writes out chksums for tracers. subroutine MOM_tracer_chksum(mesg, Tr, ntr, G) character(len=*), intent(in) :: mesg !< message that appears on the chksum lines type(tracer_type), intent(in) :: Tr(:) !< array of all of registered tracers integer, intent(in) :: ntr !< number of registered tracers type(ocean_grid_type), intent(in) :: G !< ocean grid structure - integer :: is, ie, js, je, nz, m - is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + integer :: is, ie, js, je, nz + integer :: i, j, k, m + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke do m=1,ntr call hchksum(Tr(m)%t, mesg//trim(Tr(m)%name), G%HI) enddo end subroutine MOM_tracer_chksum +!> Calculates and prints the global inventory of all tracers in the registry. +subroutine MOM_tracer_chkinv(mesg, G, h, Tr, ntr) + character(len=*), intent(in) :: mesg !< message that appears on the chksum lines + type(ocean_grid_type), intent(in) :: G !< ocean grid structure + type(tracer_type), intent(in) :: Tr(:) !< array of all of registered tracers + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), intent(in) :: h !< Layer thicknesses + integer, intent(in) :: ntr !< number of registered tracers + + real, dimension(SZI_(G),SZJ_(G),SZK_(G)) :: tr_inv !< Tracer inventory + real :: total_inv + integer :: is, ie, js, je, nz + integer :: i, j, k, m + + is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + do m=1,ntr + do k=1,nz ; do j=js,je ; do i=is,ie + tr_inv(i,j,k) = Tr(m)%t(i,j,k)*h(i,j,k)*G%areaT(i,j)*G%mask2dT(i,j) + enddo ; enddo ; enddo + total_inv = reproducing_sum(tr_inv, is, ie, js, je) + if (is_root_pe()) write(0,'(A,1X,A5,1X,ES25.16,1X,A)') "h-point: inventory", Tr(m)%name, total_inv, mesg + enddo + +end subroutine MOM_tracer_chkinv !> This routine include declares and sets the variable "version". subroutine tracer_registry_init(param_file, Reg) @@ -271,14 +297,14 @@ subroutine tracer_registry_init(param_file, Reg) integer, save :: init_calls = 0 #include "version_variable.h" - character(len=40) :: mod = "MOM_tracer_registry" ! This module's name. + character(len=40) :: mdl = "MOM_tracer_registry" ! This module's name. character(len=256) :: mesg ! Message for error messages. if (.not.associated(Reg)) then ; allocate(Reg) else ; return ; endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") init_calls = init_calls + 1 if (init_calls > 1) then diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 04eaa2276e..415b4836d3 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -63,7 +63,7 @@ module advection_test_tracer use MOM_hor_index, only : hor_index_type use MOM_io, only : file_exists, read_data, slasher, vardesc, var_desc, query_vardesc use MOM_open_boundary, only : ocean_OBC_type -use MOM_restart, only : register_restart_field, MOM_restart_CS +use MOM_restart, only : register_restart_field, query_initialized, MOM_restart_CS use MOM_sponge, only : set_up_sponge_field, sponge_CS use MOM_time_manager, only : time_type, get_time use MOM_tracer_registry, only : register_tracer, tracer_registry_type @@ -110,6 +110,7 @@ module advection_test_tracer real :: land_val(NTR) = -1.0 ! The value of tr used where land is masked out. logical :: mask_tracers ! If true, tracers are masked out in massless layers. logical :: use_sponge + logical :: tracers_may_reinit real :: x_origin, x_width ! Parameters describing the test functions real :: y_origin, y_width ! Parameters describing the test functions @@ -120,6 +121,8 @@ module advection_test_tracer type(diag_ctrl), pointer :: diag ! A structure that is used to regulate the ! timing of diagnostic output. + type(MOM_restart_CS), pointer :: restart_CSp => NULL() + integer, dimension(NTR) :: id_tracer = -1, id_tr_adx = -1, id_tr_ady = -1 integer, dimension(NTR) :: id_tr_dfx = -1, id_tr_dfy = -1 @@ -149,7 +152,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ character(len=80) :: name, longname ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "advection_test_tracer" ! This module's name. + character(len=40) :: mdl = "advection_test_tracer" ! This module's name. character(len=200) :: inputdir real, pointer :: tr_ptr(:,:,:) => NULL() logical :: register_advection_test_tracer @@ -164,35 +167,41 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") - call get_param(param_file, mod, "ADVECTION_TEST_X_ORIGIN", CS%x_origin, & + call get_param(param_file, mdl, "ADVECTION_TEST_X_ORIGIN", CS%x_origin, & "The x-coorindate of the center of the test-functions.\n", default=0.) - call get_param(param_file, mod, "ADVECTION_TEST_Y_ORIGIN", CS%y_origin, & + call get_param(param_file, mdl, "ADVECTION_TEST_Y_ORIGIN", CS%y_origin, & "The y-coorindate of the center of the test-functions.\n", default=0.) - call get_param(param_file, mod, "ADVECTION_TEST_X_WIDTH", CS%x_width, & + call get_param(param_file, mdl, "ADVECTION_TEST_X_WIDTH", CS%x_width, & "The x-width of the test-functions.\n", default=0.) - call get_param(param_file, mod, "ADVECTION_TEST_Y_WIDTH", CS%y_width, & + call get_param(param_file, mdl, "ADVECTION_TEST_Y_WIDTH", CS%y_width, & "The y-width of the test-functions.\n", default=0.) - call get_param(param_file, mod, "ADVECTION_TEST_TRACER_IC_FILE", CS%tracer_IC_file, & + call get_param(param_file, mdl, "ADVECTION_TEST_TRACER_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& "conditions for the tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%tracer_IC_file = trim(slasher(inputdir))//trim(CS%tracer_IC_file) - call log_param(param_file, mod, "INPUTDIR/ADVECTION_TEST_TRACER_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/ADVECTION_TEST_TRACER_IC_FILE", & CS%tracer_IC_file) endif - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) - call get_param(param_file, mod, "MASK_TRACERS_IN_MASSLESS_LAYERS", CS%mask_tracers, & + call get_param(param_file, mdl, "MASK_TRACERS_IN_MASSLESS_LAYERS", CS%mask_tracers, & "If true, tracers will be masked out in massless layers. \n", & default=.false.) + call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & + "If true, tracers may go through the initialization code \n"//& + "if they are not found in the restart files. Otherwise \n"//& + "it is a fatal error if the tracers are not found in the \n"//& + "restart files of a restarted run.", default=.false.) + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 if (CS%mask_tracers) then @@ -203,13 +212,14 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ if (m < 10) then ; write(name,'("tr",I1.1)') m else ; write(name,'("tr",I2.2)') m ; endif write(longname,'("Concentration of Tracer ",I2.2)') m - CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. tr_ptr => CS%tr(:,:,:,m) ! Register the tracer for the restart file. - call register_restart_field(tr_ptr, CS%tr_desc(m), .true., restart_CS) + call register_restart_field(tr_ptr, CS%tr_desc(m), & + .not. CS%tracers_may_reinit, restart_CS) ! Register the tracer for horizontal advection & diffusion. call register_tracer(tr_ptr, CS%tr_desc(m), param_file, HI, GV, tr_Reg, & tr_desc_ptr=CS%tr_desc(m)) @@ -223,6 +233,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ enddo CS%tr_Reg => tr_Reg + CS%restart_CSp => restart_CS register_advection_test_tracer = .true. end function register_advection_test_tracer @@ -285,8 +296,11 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS CS%diag => diag CS%ntr = NTR - if (.not.restart) then - do m=1,NTR + do m=1,NTR + call query_vardesc(CS%tr_desc(m), name=name, & + caller="initialize_advection_test_tracer") + if ((.not.restart) .or. (CS%tracers_may_reinit .and. .not. & + query_initialized(CS%tr(:,:,:,m), name, CS%restart_CSp))) then do k=1,nz ; do j=js,je ; do i=is,ie CS%tr(i,j,k,m) = 0.0 enddo ; enddo ; enddo @@ -320,8 +334,9 @@ subroutine initialize_advection_test_tracer(restart, day, G, GV, h,diag, OBC, CS if (locx**2+locy**2<=1.0) CS%tr(i,j,k,m) = 1.0 if (locx>0.0.and.abs(locy)<0.2) CS%tr(i,j,k,m) = 0.0 enddo ; enddo - enddo - endif ! restart + endif ! restart + enddo + ! This needs to be changed if the units of tracer are changed above. if (GV%Boussinesq) then ; flux_units = "kg kg-1 m3 s-1" diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index b197d88047..d4e29c02f5 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -101,7 +101,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "boundary_impulse_tracer" ! This module's name. + character(len=40) :: mdl = "boundary_impulse_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying boundary_impulse @@ -119,13 +119,13 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "IMPULSE_SOURCE_TIME", CS%remaining_source_time, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "IMPULSE_SOURCE_TIME", CS%remaining_source_time, & "Length of time for the boundary tracer to be injected\n"//& "into the mixed layer. After this time has elapsed, the\n"//& "surface becomes a sink for the boundary impulse tracer.", & default=31536000.0) - call get_param(param_file, mod, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & + call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code \n"//& "if they are not found in the restart files. Otherwise \n"//& "it is a fatal error if the tracers are not found in the \n"//& @@ -139,7 +139,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. CS%tr_desc(m) = var_desc(trim("boundary_impulse"), "kg", & - "Boundary impulse tracer", caller=mod) + "Boundary impulse tracer", caller=mdl) tr_ptr => CS%tr(:,:,:,m) call query_vardesc(CS%tr_desc(m), name=var_name, caller="register_boundary_impulse_tracer") ! Register the tracer for the restart file. @@ -160,7 +160,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar rem_time_ptr => CS%remaining_source_time call register_restart_field(rem_time_ptr, & var_desc(trim("bir_remain_time"), "s", "Remaining time to apply BIR source", & - hor_grid = "1", z_grid = "1", caller=mod), & + hor_grid = "1", z_grid = "1", caller=mdl), & .not. CS%tracers_may_reinit, restart_CS) CS%tr_Reg => tr_Reg diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 70a2077d70..acf18e4e18 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -146,7 +146,7 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "regional_dyes" ! This module's name. + character(len=40) :: mdl = "regional_dyes" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=48) :: desc_name ! The variable's descriptor. @@ -163,8 +163,8 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "NUM_DYE_TRACERS", CS%ntr, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "NUM_DYE_TRACERS", CS%ntr, & "The number of dye tracers in this run. Each tracer \n"//& "should have a separate region.", default=0) allocate(CS%dye_source_minlon(CS%ntr), & @@ -192,42 +192,42 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%id_tr_dfy(:) = -1 CS%dye_source_minlon(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MINLON", CS%dye_source_minlon, & + call get_param(param_file, mdl, "DYE_SOURCE_MINLON", CS%dye_source_minlon, & "This is the starting longitude at which we start injecting dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_minlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLON ") CS%dye_source_maxlon(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MAXLON", CS%dye_source_maxlon, & + call get_param(param_file, mdl, "DYE_SOURCE_MAXLON", CS%dye_source_maxlon, & "This is the ending longitude at which we finish injecting dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_maxlon(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLON ") CS%dye_source_minlat(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MINLAT", CS%dye_source_minlat, & + call get_param(param_file, mdl, "DYE_SOURCE_MINLAT", CS%dye_source_minlat, & "This is the starting latitude at which we start injecting dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_minlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINLAT ") CS%dye_source_maxlat(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MAXLAT", CS%dye_source_maxlat, & + call get_param(param_file, mdl, "DYE_SOURCE_MAXLAT", CS%dye_source_maxlat, & "This is the ending latitude at which we finish injecting dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_maxlat(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXLAT ") CS%dye_source_mindepth(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & + call get_param(param_file, mdl, "DYE_SOURCE_MINDEPTH", CS%dye_source_mindepth, & "This is the minumum depth at which we inject dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_mindepth(:)) < -1.e29) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MINDEPTH") CS%dye_source_maxdepth(:) = -1.e30 - call get_param(param_file, mod, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & + call get_param(param_file, mdl, "DYE_SOURCE_MAXDEPTH", CS%dye_source_maxdepth, & "This is the maximum depth at which we inject dyes.", & fail_if_missing=.true.) if (minval(CS%dye_source_maxdepth(:)) < -1.e29) & @@ -236,7 +236,7 @@ function register_dye_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) do m = 1, CS%ntr write(var_name(:),'(A,I3.3)') "dye",m write(desc_name(:),'(A,I3.3)') "Dye Tracer ",m - CS%tr_desc(m) = var_desc(trim(var_name), "conc", trim(desc_name), caller=mod) + CS%tr_desc(m) = var_desc(trim(var_name), "conc", trim(desc_name), caller=mdl) enddo diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 6b9f403d9b..f70327ee95 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -161,7 +161,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "ideal_age_example" ! This module's name. + character(len=40) :: mdl = "ideal_age_example" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. real, pointer :: tr_ptr(:,:,:) => NULL() @@ -178,16 +178,16 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DO_IDEAL_AGE", do_ideal_age, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DO_IDEAL_AGE", do_ideal_age, & "If true, use an ideal age tracer that is set to 0 age \n"//& "in the mixed layer and ages at unit rate in the interior.", & default=.true.) - call get_param(param_file, mod, "DO_IDEAL_VINTAGE", do_vintage, & + call get_param(param_file, mdl, "DO_IDEAL_VINTAGE", do_vintage, & "If true, use an ideal vintage tracer that is set to an \n"//& "exponentially increasing value in the mixed layer and \n"//& "is conserved thereafter.", default=.false.) - call get_param(param_file, mod, "DO_IDEAL_AGE_DATED", do_ideal_age_dated, & + call get_param(param_file, mdl, "DO_IDEAL_AGE_DATED", do_ideal_age_dated, & "If true, use an ideal age tracer that is everywhere 0 \n"//& "before IDEAL_AGE_DATED_START_YEAR, but the behaves like \n"//& "the standard ideal age tracer - i.e. is set to 0 age in \n"//& @@ -195,23 +195,23 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) default=.false.) - call get_param(param_file, mod, "AGE_IC_FILE", CS%IC_file, & + call get_param(param_file, mdl, "AGE_IC_FILE", CS%IC_file, & "The file in which the age-tracer initial values can be \n"//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then ! Add the directory if CS%IC_file is not already a complete path. - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%IC_file = trim(slasher(inputdir))//trim(CS%IC_file) - call log_param(param_file, mod, "INPUTDIR/AGE_IC_FILE", CS%IC_file) + call log_param(param_file, mdl, "INPUTDIR/AGE_IC_FILE", CS%IC_file) endif - call get_param(param_file, mod, "AGE_IC_FILE_IS_Z", CS%Z_IC_file, & + call get_param(param_file, mdl, "AGE_IC_FILE_IS_Z", CS%Z_IC_file, & "If true, AGE_IC_FILE is in depth space, not layer space", & default=.false.) - call get_param(param_file, mod, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & + call get_param(param_file, mdl, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & "If true, the tracers are masked out in massless layer. \n"//& "This can be a problem with time-averages.", default=.false.) - call get_param(param_file, mod, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & + call get_param(param_file, mdl, "TRACERS_MAY_REINIT", CS%tracers_may_reinit, & "If true, tracers may go through the initialization code \n"//& "if they are not found in the restart files. Otherwise \n"//& "it is a fatal error if the tracers are not found in the \n"//& @@ -220,7 +220,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%ntr = 0 if (do_ideal_age) then CS%ntr = CS%ntr + 1 ; m = CS%ntr - CS%tr_desc(m) = var_desc("age", "years", "Ideal Age Tracer", cmor_field_name="agessc", caller=mod) + CS%tr_desc(m) = var_desc("age", "years", "Ideal Age Tracer", cmor_field_name="agessc", caller=mdl) CS%tracer_ages(m) = .true. ; CS%sfc_growth_rate(m) = 0.0 CS%IC_val(m) = 0.0 ; CS%young_val(m) = 0.0 ; CS%tracer_start_year(m) = 0.0 endif @@ -228,10 +228,10 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) if (do_vintage) then CS%ntr = CS%ntr + 1 ; m = CS%ntr CS%tr_desc(m) = var_desc("vintage", "years", "Exponential Vintage Tracer", & - caller=mod) + caller=mdl) CS%tracer_ages(m) = .false. ; CS%sfc_growth_rate(m) = 1.0/30.0 CS%IC_val(m) = 0.0 ; CS%young_val(m) = 1e-20 ; CS%tracer_start_year(m) = 0.0 - call get_param(param_file, mod, "IDEAL_VINTAGE_START_YEAR", CS%tracer_start_year(m), & + call get_param(param_file, mdl, "IDEAL_VINTAGE_START_YEAR", CS%tracer_start_year(m), & "The date at which the ideal vintage tracer starts.", & units="years", default=0.0) endif @@ -239,10 +239,10 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) if (do_ideal_age_dated) then CS%ntr = CS%ntr + 1 ; m = CS%ntr CS%tr_desc(m) = var_desc("age_dated","years","Ideal Age Tracer with a Start Date",& - caller=mod) + caller=mdl) CS%tracer_ages(m) = .true. ; CS%sfc_growth_rate(m) = 0.0 CS%IC_val(m) = 0.0 ; CS%young_val(m) = 0.0 ; CS%tracer_start_year(m) = 0.0 - call get_param(param_file, mod, "IDEAL_AGE_DATED_START_YEAR", CS%tracer_start_year(m), & + call get_param(param_file, mdl, "IDEAL_AGE_DATED_START_YEAR", CS%tracer_start_year(m), & "The date at which the dated ideal age tracer starts.", & units="years", default=0.0) endif diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index cc370ad74d..37b713046a 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -164,7 +164,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "oil_tracer" ! This module's name. + character(len=40) :: mdl = "oil_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying oils @@ -181,51 +181,51 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "OIL_IC_FILE", CS%IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "OIL_IC_FILE", CS%IC_file, & "The file in which the oil tracer initial values can be \n"//& "found, or an empty string for internal initialization.", & default=" ") if ((len_trim(CS%IC_file) > 0) .and. (scan(CS%IC_file,'/') == 0)) then ! Add the directory if CS%IC_file is not already a complete path. - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%IC_file = trim(slasher(inputdir))//trim(CS%IC_file) - call log_param(param_file, mod, "INPUTDIR/CFC_IC_FILE", CS%IC_file) + call log_param(param_file, mdl, "INPUTDIR/CFC_IC_FILE", CS%IC_file) endif - call get_param(param_file, mod, "OIL_IC_FILE_IS_Z", CS%Z_IC_file, & + call get_param(param_file, mdl, "OIL_IC_FILE_IS_Z", CS%Z_IC_file, & "If true, OIL_IC_FILE is in depth space, not layer space", & default=.false.) - call get_param(param_file, mod, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & + call get_param(param_file, mdl, "MASK_MASSLESS_TRACERS", CS%mask_tracers, & "If true, the tracers are masked out in massless layer. \n"//& "This can be a problem with time-averages.", default=.false.) - call get_param(param_file, mod, "OIL_MAY_REINIT", CS%oil_may_reinit, & + call get_param(param_file, mdl, "OIL_MAY_REINIT", CS%oil_may_reinit, & "If true, oil tracers may go through the initialization \n"//& "code if they are not found in the restart files. \n"//& "Otherwise it is a fatal error if the oil tracers are not \n"//& "found in the restart files of a restarted run.", & default=.false.) - call get_param(param_file, mod, "OIL_SOURCE_LONGITUDE", CS%oil_source_longitude, & + call get_param(param_file, mdl, "OIL_SOURCE_LONGITUDE", CS%oil_source_longitude, & "The geographic longitude of the oil source.", units="degrees E", & fail_if_missing=.true.) - call get_param(param_file, mod, "OIL_SOURCE_LATITUDE", CS%oil_source_latitude, & + call get_param(param_file, mdl, "OIL_SOURCE_LATITUDE", CS%oil_source_latitude, & "The geographic latitude of the oil source.", units="degrees N", & fail_if_missing=.true.) - call get_param(param_file, mod, "OIL_SOURCE_LAYER", CS%oil_source_k, & + call get_param(param_file, mdl, "OIL_SOURCE_LAYER", CS%oil_source_k, & "The layer into which the oil is introduced, or a \n"//& "negative number for a vertically uniform source, \n"//& "or 0 not to use this tracer.", units="Layer", default=0) - call get_param(param_file, mod, "OIL_SOURCE_RATE", CS%oil_source_rate, & + call get_param(param_file, mdl, "OIL_SOURCE_RATE", CS%oil_source_rate, & "The rate of oil injection.", units="kg s-1", default=1.0) - call get_param(param_file, mod, "OIL_DECAY_DAYS", CS%oil_decay_days, & + call get_param(param_file, mdl, "OIL_DECAY_DAYS", CS%oil_decay_days, & "The decay timescale in days (if positive), or no decay \n"//& "if 0, or use the temperature dependent decay rate of \n"//& "Adcroft et al. (GRL, 2010) if negative.", units="days", & default=0.0) - call get_param(param_file, mod, "OIL_DATED_START_YEAR", CS%oil_start_year, & + call get_param(param_file, mdl, "OIL_DATED_START_YEAR", CS%oil_start_year, & "The time at which the oil source starts", units="years", & default=0.0) - call get_param(param_file, mod, "OIL_DATED_END_YEAR", CS%oil_end_year, & + call get_param(param_file, mdl, "OIL_DATED_END_YEAR", CS%oil_end_year, & "The time at which the oil source ends", units="years", & default=1.0e99) @@ -235,7 +235,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) if (CS%oil_source_k(m)/=0) then write(name_tag(1:3),'("_",I2.2)') m CS%ntr = CS%ntr + 1 - CS%tr_desc(m) = var_desc("oil"//trim(name_tag), "kg/m3", "Oil Tracer", caller=mod) + CS%tr_desc(m) = var_desc("oil"//trim(name_tag), "kg/m3", "Oil Tracer", caller=mdl) CS%IC_val(m) = 0.0 if (CS%oil_decay_days(m)>0.) then CS%oil_decay_rate(m)=1./(86400.0*CS%oil_decay_days(m)) @@ -244,7 +244,7 @@ function register_oil_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) endif endif enddo - call log_param(param_file, mod, "OIL_DECAY_RATE", CS%oil_decay_rate(1:CS%ntr)) + call log_param(param_file, mdl, "OIL_DECAY_RATE", CS%oil_decay_rate(1:CS%ntr)) allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index c611eb8b5a..8f48c2b55b 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -147,7 +147,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "pseudo_salt_tracer" ! This module's name. + character(len=40) :: mdl = "pseudo_salt_tracer" ! This module's name. character(len=200) :: inputdir ! The directory where the input files are. character(len=48) :: var_name ! The variable's name. character(len=3) :: name_tag ! String for creating identifying pseudo_salt @@ -164,7 +164,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") + call log_version(param_file, mdl, version, "") CS%ntr = NTR_MAX allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 @@ -174,7 +174,7 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. CS%tr_desc(m) = var_desc(trim("pseudo_salt_diff"), "kg", & - "Difference between pseudo salt passive tracer and salt tracer", caller=mod) + "Difference between pseudo salt passive tracer and salt tracer", caller=mdl) tr_ptr => CS%tr(:,:,:,m) call query_vardesc(CS%tr_desc(m), name=var_name, caller="register_pseudo_salt_tracer") ! Register the tracer for the restart file. diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index e7357daf09..964754210e 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -140,7 +140,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS character(len=80) :: name, longname ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "tracer_example" ! This module's name. + character(len=40) :: mdl = "tracer_example" ! This module's name. character(len=200) :: inputdir real, pointer :: tr_ptr(:,:,:) => NULL() logical :: USER_register_tracer_example @@ -155,18 +155,18 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "TRACER_EXAMPLE_IC_FILE", CS%tracer_IC_file, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "TRACER_EXAMPLE_IC_FILE", CS%tracer_IC_file, & "The name of a file from which to read the initial \n"//& "conditions for the DOME tracers, or blank to initialize \n"//& "them internally.", default=" ") if (len_trim(CS%tracer_IC_file) >= 1) then - call get_param(param_file, mod, "INPUTDIR", inputdir, default=".") + call get_param(param_file, mdl, "INPUTDIR", inputdir, default=".") CS%tracer_IC_file = trim(slasher(inputdir))//trim(CS%tracer_IC_file) - call log_param(param_file, mod, "INPUTDIR/TRACER_EXAMPLE_IC_FILE", & + call log_param(param_file, mdl, "INPUTDIR/TRACER_EXAMPLE_IC_FILE", & CS%tracer_IC_file) endif - call get_param(param_file, mod, "SPONGE", CS%use_sponge, & + call get_param(param_file, mdl, "SPONGE", CS%use_sponge, & "If true, sponges may be applied anywhere in the domain. \n"//& "The exact location and properties of those sponges are \n"//& "specified from MOM_initialization.F90.", default=.false.) @@ -180,7 +180,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS if (m < 10) then ; write(name,'("tr",I1.1)') m else ; write(name,'("tr",I2.2)') m ; endif write(longname,'("Concentration of Tracer ",I2.2)') m - CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mod) + CS%tr_desc(m) = var_desc(name, units="kg kg-1", longname=longname, caller=mdl) ! This is needed to force the compiler not to do a copy in the registration ! calls. Curses on the designers and implementers of Fortran90. diff --git a/src/user/BFB_initialization.F90 b/src/user/BFB_initialization.F90 index 0d6f801ae3..9481d3bd63 100644 --- a/src/user/BFB_initialization.F90 +++ b/src/user/BFB_initialization.F90 @@ -72,14 +72,14 @@ subroutine BFB_set_coord(Rlay, g_prime, GV, param_file, eqn_of_state) type(EOS_type), pointer :: eqn_of_state real :: drho_dt, SST_s, T_bot, rho_top, rho_bot integer :: k, nz - character(len=40) :: mod = "BFB_set_coord" ! This subroutine's name. + character(len=40) :: mdl = "BFB_set_coord" ! This subroutine's name. - call get_param(param_file, mod, "DRHO_DT", drho_dt, & + call get_param(param_file, mdl, "DRHO_DT", drho_dt, & "Rate of change of density with temperature.", & units="kg m-3 K-1", default=-0.2) - call get_param(param_file, mod, "SST_S", SST_s, & + call get_param(param_file, mdl, "SST_S", SST_s, & "SST at the suothern edge of the domain.", units="C", default=20.0) - call get_param(param_file, mod, "T_BOT", T_bot, & + call get_param(param_file, mdl, "T_BOT", T_bot, & "Bottom Temp", units="C", default=5.0) rho_top = GV%rho0 + drho_dt*SST_s rho_bot = GV%rho0 + drho_dt*T_bot @@ -122,7 +122,7 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, real :: H0(SZK_(G)) real :: min_depth real :: damp, e_dense, damp_new, slat, wlon, lenlat, lenlon, nlat - character(len=40) :: mod = "BFB_initialize_sponges_southonly" ! This subroutine's name. + character(len=40) :: mdl = "BFB_initialize_sponges_southonly" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -136,16 +136,16 @@ subroutine BFB_initialize_sponges_southonly(G, use_temperature, tv, param_file, ! and mask2dT is 1. ! ! Set up sponges for DOME configuration - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - call get_param(param_file, mod, "SOUTHLAT", slat, & + call get_param(param_file, mdl, "SOUTHLAT", slat, & "The southern latitude of the domain.", units="degrees") - call get_param(param_file, mod, "LENLAT", lenlat, & + call get_param(param_file, mdl, "LENLAT", lenlat, & "The latitudinal length of the domain.", units="degrees") - call get_param(param_file, mod, "WESTLON", wlon, & + call get_param(param_file, mdl, "WESTLON", wlon, & "The western longitude of the domain.", units="degrees", default=0.0) - call get_param(param_file, mod, "LENLON", lenlon, & + call get_param(param_file, mdl, "LENLON", lenlon, & "The longitudinal length of the domain.", units="degrees") nlat = slat + lenlat do k=1,nz ; H0(k) = -G%max_depth * real(k-1) / real(nz) ; enddo @@ -201,9 +201,9 @@ subroutine write_BFB_log(param_file) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "BFB_initialization" ! This module's name. + character(len=40) :: mdl = "BFB_initialization" ! This module's name. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) first_call = .false. end subroutine write_BFB_log diff --git a/src/user/BFB_surface_forcing.F90 b/src/user/BFB_surface_forcing.F90 index 8c108fc919..71c29736f1 100644 --- a/src/user/BFB_surface_forcing.F90 +++ b/src/user/BFB_surface_forcing.F90 @@ -264,7 +264,7 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "BFB_surface_forcing" ! This module's name. + character(len=40) :: mdl = "BFB_surface_forcing" ! This module's name. if (associated(CS)) then call MOM_error(WARNING, "BFB_surface_forcing_init called with an associated "// & @@ -275,45 +275,45 @@ subroutine BFB_surface_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "ENABLE_THERMODYNAMICS", CS%use_temperature, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & "If true, Temperature and salinity are used as state \n"//& "variables.", default=.true.) - call get_param(param_file, mod, "G_EARTH", CS%G_Earth, & + call get_param(param_file, mdl, "G_EARTH", CS%G_Earth, & "The gravitational acceleration of the Earth.", & units="m s-2", default = 9.80) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) - call get_param(param_file, mod, "LFR_SLAT", CS%lfrslat, & + call get_param(param_file, mdl, "LFR_SLAT", CS%lfrslat, & "Southern latitude where the linear forcing ramp begins.", & units="degrees", default = 20.0) - call get_param(param_file, mod, "LFR_NLAT", CS%lfrnlat, & + call get_param(param_file, mdl, "LFR_NLAT", CS%lfrnlat, & "Northern latitude where the linear forcing ramp ends.", & units="degrees", default = 40.0) - call get_param(param_file, mod, "SST_S", CS%SST_s, & + call get_param(param_file, mdl, "SST_S", CS%SST_s, & "SST at the southern edge of the linear forcing ramp.", & units="C", default = 20.0) - call get_param(param_file, mod, "SST_N", CS%SST_n, & + call get_param(param_file, mdl, "SST_N", CS%SST_n, & "SST at the northern edge of the linear forcing ramp.", & units="C", default = 10.0) - call get_param(param_file, mod, "DRHO_DT", CS%drho_dt, & + call get_param(param_file, mdl, "DRHO_DT", CS%drho_dt, & "The rate of change of density with temperature.", & units="kg m-3 K-1", default = -0.2) - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.02) - call get_param(param_file, mod, "RESTOREBUOY", CS%restorebuoy, & + call get_param(param_file, mdl, "RESTOREBUOY", CS%restorebuoy, & "If true, the buoyancy fluxes drive the model back \n"//& "toward some specified surface state with a rate \n"//& "given by FLUXCONST.", default= .false.) if (CS%restorebuoy) then - call get_param(param_file, mod, "FLUXCONST", CS%Flux_const, & + call get_param(param_file, mdl, "FLUXCONST", CS%Flux_const, & "The constant that relates the restoring surface fluxes \n"//& "to the relative surface anomalies (akin to a piston \n"//& "velocity). Note the non-MKS units.", units="m day-1", & diff --git a/src/user/DOME2d_initialization.F90 b/src/user/DOME2d_initialization.F90 index 4d926f828e..0e37ba25a4 100644 --- a/src/user/DOME2d_initialization.F90 +++ b/src/user/DOME2d_initialization.F90 @@ -27,7 +27,7 @@ module DOME2d_initialization public DOME2d_initialize_temperature_salinity public DOME2d_initialize_sponges -character(len=40) :: mod = "DOEM2D_initialization" !< This module's name. +character(len=40) :: mdl = "DOME2D_initialization" !< This module's name. contains @@ -43,14 +43,17 @@ subroutine DOME2d_initialize_topography ( D, G, param_file, max_depth ) integer :: i, j real :: x, bay_depth, l1, l2 real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay +! This include declares and sets the variable "version". +#include "version_variable.h" - call get_param(param_file, mod, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & 'Width of shelf, as fraction of domain, in 2d DOME configuration.', & units='nondim',default=0.1) - call get_param(param_file, mod, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & + call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & 'Width of deep ocean basin, as fraction of domain, in 2d DOME configuration.', & units='nondim',default=0.3) - call get_param(param_file, mod, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & 'Depth of shelf, as fraction of basin depth, in 2d DOME configuration.', & units='nondim',default=0.2) @@ -82,38 +85,49 @@ subroutine DOME2d_initialize_topography ( D, G, param_file, max_depth ) end subroutine DOME2d_initialize_topography !> Initialize thicknesses according to coordinate mode -subroutine DOME2d_initialize_thickness ( h, G, GV, param_file ) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: h !< Layer thicknesses - type(param_file_type), intent(in) :: param_file !< Parameter file structure +subroutine DOME2d_initialize_thickness ( h, G, GV, param_file, just_read_params ) + type(ocean_grid_type), intent(in) :: G !< Ocean grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! + ! positive upward, in m. ! integer :: i, j, k, is, ie, js, je, nz real :: x real :: delta_h real :: min_thickness - character(len=40) :: verticalCoordinate real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file,mod,"MIN_THICKNESS",min_thickness, & + if (.not.just_read) & + call MOM_mesg("MOM_initialization.F90, DOME2d_initialize_thickness: setting thickness") + + call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & default=1.e-3, do_not_log=.true.) - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & default=0.1, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & + call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & default=0.3, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & default=0.2, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. + ! WARNING: this routine specifies the interface heights so that the last layer ! is vanished, even at maximum depth. In order to have a uniform ! layer distribution, use this line of code within the loop: @@ -202,13 +216,17 @@ end subroutine DOME2d_initialize_thickness !> Initialize temperature and salinity in the 2d DOME configuration -subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, param_file, eqn_of_state) +subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, param_file, & + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness (m or Pa) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables integer :: i, j, k, is, ie, js, je, nz real :: x; @@ -217,23 +235,32 @@ subroutine DOME2d_initialize_temperature_salinity ( T, S, h, G, param_file, eqn_ real :: S_ref, T_ref; ! Reference salinity and temperature within surface layer real :: S_range, T_range; ! Range of salinities and temperatures over the vertical real :: xi0, xi1; + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate real :: dome2d_width_bay, dome2d_width_bottom, dome2d_depth_bay is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & default=0.1, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & + call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & default=0.3, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & default=0.2, do_not_log=.true.) - call get_param(param_file,mod,"S_REF",S_ref,'Reference salinity',units='1e-3',fail_if_missing=.true.) - call get_param(param_file,mod,"T_REF",T_ref,'Refernce temperature',units='C',fail_if_missing=.true.) - call get_param(param_file,mod,"S_RANGE",S_range,'Initial salinity range',units='1e-3',default=2.0) - call get_param(param_file,mod,"T_RANGE",T_range,'Initial temperature range',units='1e-3',default=0.0) + call get_param(param_file, mdl,"S_REF",S_ref,'Reference salinity',units='1e-3', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Refernce temperature',units='C', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range', & + units='1e-3', default=2.0, do_not_log=just_read) + call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + units='1e-3', default=0.0, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. T(:,:,:) = 0.0 S(:,:,:) = 0.0 @@ -349,19 +376,19 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call get_param(param_file, mod, "DOME2D_WEST_SPONGE_TIME_SCALE", dome2d_west_sponge_time_scale, & + call get_param(param_file, mdl, "DOME2D_WEST_SPONGE_TIME_SCALE", dome2d_west_sponge_time_scale, & 'The time-scale on the west edge of the domain for restoring T/S\n' //& 'in the sponge. If zero, the western sponge is disabled', & units='s', default=0.) - call get_param(param_file, mod, "DOME2D_EAST_SPONGE_TIME_SCALE", dome2d_east_sponge_time_scale, & + call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_TIME_SCALE", dome2d_east_sponge_time_scale, & 'The time-scale on the east edge of the domain for restoring T/S\n' //& 'in the sponge. If zero, the eastern sponge is disabled', & units='s', default=0.) - call get_param(param_file, mod, "DOME2D_WEST_SPONGE_WIDTH", dome2d_west_sponge_width, & + call get_param(param_file, mdl, "DOME2D_WEST_SPONGE_WIDTH", dome2d_west_sponge_width, & 'The fraction of the domain in which the western sponge for restoring T/S\n' //& 'is active.', & units='nondim', default=0.1) - call get_param(param_file, mod, "DOME2D_EAST_SPONGE_WIDTH", dome2d_east_sponge_width, & + call get_param(param_file, mdl, "DOME2D_EAST_SPONGE_WIDTH", dome2d_east_sponge_width, & 'The fraction of the domain in which the eastern sponge for restoring T/S\n' //& 'is active.', & units='nondim', default=0.1) @@ -374,16 +401,16 @@ subroutine DOME2d_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, ACSp) if (associated(ACSp)) call MOM_error(FATAL, & "DOME2d_initialize_sponges called with an associated ALE-sponge control structure.") - call get_param(param_file, mod, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_WIDTH", dome2d_width_bay, & default=0.1, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & + call get_param(param_file, mdl, "DOME2D_BASIN_WIDTH", dome2d_width_bottom, & default=0.3, do_not_log=.true.) - call get_param(param_file, mod, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & + call get_param(param_file, mdl, "DOME2D_SHELF_DEPTH", dome2d_depth_bay, & default=0.2, do_not_log=.true.) - call get_param(param_file,mod,"S_REF",S_ref) - call get_param(param_file,mod,"T_REF",T_ref) - call get_param(param_file,mod,"S_RANGE",S_range,default=2.0) - call get_param(param_file,mod,"T_RANGE",T_range,default=0.0) + call get_param(param_file, mdl,"S_REF",S_ref) + call get_param(param_file, mdl,"T_REF",T_ref) + call get_param(param_file, mdl,"S_RANGE",S_range,default=2.0) + call get_param(param_file, mdl,"T_RANGE",T_range,default=0.0) ! Set the inverse damping rate as a function of position diff --git a/src/user/DOME_initialization.F90 b/src/user/DOME_initialization.F90 index 81d301fc08..0ffe4c946f 100644 --- a/src/user/DOME_initialization.F90 +++ b/src/user/DOME_initialization.F90 @@ -55,15 +55,15 @@ subroutine DOME_initialize_topography(D, G, param_file, max_depth) real :: min_depth ! The minimum and maximum depths in m. ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "DOME_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "DOME_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call MOM_mesg(" DOME_initialization.F90, DOME_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) do j=js,je ; do i=is,ie @@ -90,22 +90,30 @@ end subroutine DOME_initialize_topography ! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the DOME experiment -subroutine DOME_initialize_thickness(h, G, GV, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file - !! to parse for model parameter values. - - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! +subroutine DOME_initialize_thickness(h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! ! positive upward, in m. ! - character(len=40) :: mod = "DOME_initialize_thickness" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "DOME_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! This subroutine has no run-time parameters. + call MOM_mesg(" DOME_initialization.F90, DOME_initialize_thickness: setting thickness", 5) e0(1)=0.0 @@ -158,7 +166,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) real :: H0(SZK_(G)) real :: min_depth real :: damp, e_dense, damp_new - character(len=40) :: mod = "DOME_initialize_sponges" ! This subroutine's name. + character(len=40) :: mdl = "DOME_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -172,7 +180,7 @@ subroutine DOME_initialize_sponges(G, GV, tv, PF, CSp) ! and mask2dT is 1. ! ! Set up sponges for DOME configuration - call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) H0(1) = 0.0 @@ -267,7 +275,7 @@ subroutine DOME_set_OBC_data(OBC, tv, G, GV, param_file, tr_Reg) ! thickness D_edge, in the same units as lat. real :: Ri_trans ! The shear Richardson number in the transition ! region of the specified shear profile. - character(len=40) :: mod = "DOME_set_OBC_data" ! This subroutine's name. + character(len=40) :: mdl = "DOME_set_OBC_data" ! This subroutine's name. integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment diff --git a/src/user/ISOMIP_initialization.F90 b/src/user/ISOMIP_initialization.F90 index 885b8d97f6..e3adee02c4 100644 --- a/src/user/ISOMIP_initialization.F90 +++ b/src/user/ISOMIP_initialization.F90 @@ -44,7 +44,7 @@ module ISOMIP_initialization ! Private (module-wise) parameters ! ----------------------------------------------------------------------------- -character(len=40) :: mod = "ISOMIP_initialization" ! This module's name. +character(len=40) :: mdl = "ISOMIP_initialization" ! This module's name. ! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world @@ -87,7 +87,7 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "ISOMIP_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "ISOMIP_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -95,10 +95,10 @@ subroutine ISOMIP_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" ISOMIP_initialization.F90, ISOMIP_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - call get_param(param_file, mod, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) + call get_param(param_file, mdl, "ISOMIP_2D",is_2D,'If true, use a 2D setup.', default=.false.) ! The following variables should be transformed into runtime parameters? bmax=720.0; b0=-150.0; b2=-728.8; b4=343.91; b6=-50.57 @@ -151,17 +151,19 @@ end subroutine ISOMIP_initialize_topography ! ----------------------------------------------------------------------------- !> Initialization of thicknesses -subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv ) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being - !! initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers - !! to any available thermodynamic - !! fields, including eq. of state. +subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + type(thermo_var_ptrs), intent(in) :: tv !< A structure containing pointers to any + !! available thermodynamic fields, including + !! the eqn. of state. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -171,23 +173,34 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv ) real :: x real :: delta_h, rho_range real :: min_thickness, s_sur, s_bot, t_sur, t_bot, rho_sur, rho_bot + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) + if (.not.just_read) & + call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + + call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + 'Minimum layer thickness', units='m', default=1.e-3, do_not_log=just_read) + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates - call get_param(param_file, mod, "ISOMIP_T_SUR",t_sur,'Temperature at the surface (interface)', default=-1.9) - call get_param(param_file, mod, "ISOMIP_S_SUR", s_sur, 'Salinity at the surface (interface)', default=33.8) - call get_param(param_file, mod, "ISOMIP_T_BOT", t_bot, 'Temperature at the bottom (interface)', default=-1.9) - call get_param(param_file, mod, "ISOMIP_S_BOT", s_bot,'Salinity at the bottom (interface)', default=34.55) + call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & + 'Temperature at the surface (interface)', default=-1.9, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_S_SUR", s_sur, & + 'Salinity at the surface (interface)', default=33.8, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_T_BOT", t_bot, & + 'Temperature at the bottom (interface)', default=-1.9, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot,& + 'Salinity at the bottom (interface)', default=34.55, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. ! Compute min/max density using T_SUR/S_SUR and T_BOT/S_BOT call calculate_density(t_sur,s_sur,0.0,rho_sur,tv%eqn_of_state) @@ -223,6 +236,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv ) enddo ; enddo case ( REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR ) ! Initial thicknesses for z coordinates + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 @@ -237,6 +251,7 @@ subroutine ISOMIP_initialize_thickness ( h, G, GV, param_file, tv ) enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = delta_h @@ -252,7 +267,7 @@ end subroutine ISOMIP_initialize_thickness !> Initial values for temperature and salinity subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & - eqn_of_state) + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) @@ -260,14 +275,17 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness (m or Pa) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure - ! Local variables + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables integer :: i, j, k, is, ie, js, je, nz, itt real :: x, ds, dt, rho_sur, rho_bot real :: xi0, xi1, dxi, r, S_sur, T_sur, S_bot, T_bot, S_range, T_range real :: z ! vertical position in z space character(len=40) :: verticalCoordinate, density_profile real :: rho_tmp + logical :: just_read ! If true, just read parameters but set nothing. logical :: fit_salin ! If true, accept the prescribed temperature and fit the salinity. real :: T0(SZK_(G)), S0(SZK_(G)) real :: drho_dT(SZK_(G)) ! Derivative of density with temperature in kg m-3 K-1. ! @@ -278,12 +296,18 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke pres(:) = 0.0 - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file, mod, "ISOMIP_T_SUR",t_sur,'Temperature at the surface (interface)', default=-1.9) - call get_param(param_file, mod, "ISOMIP_S_SUR", s_sur, 'Salinity at the surface (interface)', default=33.8) - call get_param(param_file, mod, "ISOMIP_T_BOT", t_bot, 'Temperature at the bottom (interface)', default=-1.9) - call get_param(param_file, mod, "ISOMIP_S_BOT", s_bot,'Salinity at the bottom (interface)', default=34.55) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_T_SUR",t_sur, & + 'Temperature at the surface (interface)', default=-1.9, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_S_SUR", s_sur, & + 'Salinity at the surface (interface)', default=33.8, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_T_BOT", t_bot, & + 'Temperature at the bottom (interface)', default=-1.9, do_not_log=just_read) + call get_param(param_file, mdl, "ISOMIP_S_BOT", s_bot, & + 'Salinity at the bottom (interface)', default=34.55, do_not_log=just_read) call calculate_density(t_sur,s_sur,0.0,rho_sur,eqn_of_state) !write (*,*)'Density in the surface layer:', rho_sur @@ -293,6 +317,8 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_RHO, REGRIDDING_ZSTAR, REGRIDDING_SIGMA_SHELF_ZSTAR, REGRIDDING_SIGMA ) + if (just_read) return ! All run-time parameters have been read, so return. + S_range = s_sur - s_bot T_range = t_sur - t_bot !write(*,*)'S_range,T_range',S_range,T_range @@ -310,22 +336,23 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, enddo ; enddo case ( REGRIDDING_LAYER ) - call get_param(param_file, mod, "FIT_SALINITY", fit_salin, & + call get_param(param_file, mdl, "FIT_SALINITY", fit_salin, & "If true, accept the prescribed temperature and fit the \n"//& "salinity; otherwise take salinity and fit temperature.", & - default=.false.) - call get_param(param_file, mod, "DRHO_DS", drho_dS1, & + default=.false., do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DS", drho_dS1, & "Partial derivative of density with salinity.", & - units="kg m-3 PSU-1", fail_if_missing=.true.) - call get_param(param_file, mod, "DRHO_DT", drho_dT1, & + units="kg m-3 PSU-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", drho_dT1, & "Partial derivative of density with temperature.", & - units="kg m-3 K-1", fail_if_missing=.true.) - call get_param(param_file, mod, "T_REF", T_Ref, & + units="kg m-3 K-1", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "T_REF", T_Ref, & "A reference temperature used in initialization.", & - units="degC", fail_if_missing=.true.) - call get_param(param_file, mod, "S_REF", S_Ref, & + units="degC", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "S_REF", S_Ref, & "A reference salinity used in initialization.", units="PSU", & - default=35.0) + default=35.0, do_not_log=just_read) + if (just_read) return ! All run-time parameters have been read, so return. !write(*,*)'read drho_dS, drho_dT', drho_dS1, drho_dT1 @@ -335,55 +362,55 @@ subroutine ISOMIP_initialize_temperature_salinity ( T, S, h, G, GV, param_file, S_range = S_range / G%max_depth ! Convert S_range into dS/dz T_range = T_range / G%max_depth ! Convert T_range into dT/dz - do j=js,je ; do i=is,ie - xi0 = 0.0; - do k = 1,nz - !T0(k) = T_Ref; S0(k) = S_Ref - xi1 = xi0 + 0.5 * h(i,j,k); - S0(k) = S_sur + S_range * xi1; - T0(k) = T_sur + T_range * xi1; - xi0 = xi0 + h(i,j,k); - !write(*,*)'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k - enddo - - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) - !write(*,*)'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) - call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) - - if (fit_salin) then - ! A first guess of the layers' salinity. - do k=nz,1,-1 - S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) + do j=js,je ; do i=is,ie + xi0 = 0.0; + do k = 1,nz + !T0(k) = T_Ref; S0(k) = S_Ref + xi1 = xi0 + 0.5 * h(i,j,k); + S0(k) = S_sur + S_range * xi1; + T0(k) = T_sur + T_range * xi1; + xi0 = xi0 + h(i,j,k); + !write(*,*)'S,T,xi0,xi1,k',S0(k),T0(k),xi0,xi1,k enddo - ! Refine the guesses for each layer. - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz - S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) + + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,1,eqn_of_state) + !write(*,*)'computed drho_dS, drho_dT', drho_dS(1), drho_dT(1) + call calculate_density(T0(1),S0(1),0.,rho_guess(1),eqn_of_state) + + if (fit_salin) then + ! A first guess of the layers' salinity. + do k=nz,1,-1 + S0(k) = max(0.0, S0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dS1) + enddo + ! Refine the guesses for each layer. + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz + S0(k) = max(0.0, S0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dS1) + enddo enddo - enddo - else - ! A first guess of the layers' temperatures. - do k=nz,1,-1 - T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 - enddo + else + ! A first guess of the layers' temperatures. + do k=nz,1,-1 + T0(k) = T0(1) + (GV%Rlay(k) - rho_guess(1)) / drho_dT1 + enddo - do itt=1,6 - call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) - call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) - do k=1,nz + do itt=1,6 + call calculate_density(T0,S0,pres,rho_guess,1,nz,eqn_of_state) + call calculate_density_derivs(T0,S0,pres,drho_dT,drho_dS,1,nz,eqn_of_state) + do k=1,nz T0(k) = T0(k) + (GV%Rlay(k) - rho_guess(k)) / drho_dT(k) - enddo - enddo - endif + enddo + enddo + endif - do k=1,nz - T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) - enddo + do k=1,nz + T(i,j,k) = T0(k) ; S(i,j,k) = S0(k) + enddo - enddo ; enddo + enddo ; enddo case default call MOM_error(FATAL,"isomip_initialize: "// & @@ -441,39 +468,39 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) character(len=40) :: verticalCoordinate, filename, state_file character(len=40) :: temp_var, salt_var, eta_var, inputdir - character(len=40) :: mod = "ISOMIP_initialize_sponges" ! This subroutine's name. + character(len=40) :: mdl = "ISOMIP_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call get_param(PF,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) + call get_param(PF, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness',units='m',default=1.e-3) - call get_param(PF,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + call get_param(PF, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & default=DEFAULT_COORDINATE_MODE) - call get_param(PF, mod, "ISOMIP_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) + call get_param(PF, mdl, "ISOMIP_TNUDG", TNUDG, 'Nudging time scale for sponge layers (days)', default=0.0) - call get_param(PF, mod, "T_REF", t_ref, 'Reference temperature', default=10.0,& + call get_param(PF, mdl, "T_REF", t_ref, 'Reference temperature', default=10.0,& do_not_log=.true.) - call get_param(PF, mod, "S_REF", s_ref, 'Reference salinity', default=35.0,& + call get_param(PF, mdl, "S_REF", s_ref, 'Reference salinity', default=35.0,& do_not_log=.true.) - call get_param(PF, mod, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_SUR_SPONGE", s_sur, 'Surface salinity in sponge layer.', default=s_ref) - call get_param(PF, mod, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) + call get_param(PF, mdl, "ISOMIP_S_BOT_SPONGE", s_bot, 'Bottom salinity in sponge layer.', default=s_ref) - call get_param(PF, mod, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_SUR_SPONGE", t_sur, 'Surface temperature in sponge layer.', default=t_ref) - call get_param(PF, mod, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) + call get_param(PF, mdl, "ISOMIP_T_BOT_SPONGE", t_bot, 'Bottom temperature in sponge layer.', default=t_ref) T(:,:,:) = 0.0 ; S(:,:,:) = 0.0 ; Idamp(:,:) = 0.0; RHO(:,:,:) = 0.0 S_range = s_sur - s_bot T_range = t_sur - t_bot ! Set up sponges for ISOMIP configuration - call get_param(PF, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(PF, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) if (associated(CSp)) call MOM_error(FATAL, & @@ -603,23 +630,23 @@ subroutine ISOMIP_initialize_sponges(G, GV, tv, PF, use_ALE, CSp, ACSp) else ! layer mode ! 1) Read eta, salt and temp from IC file - call get_param(PF, mod, "INPUTDIR", inputdir, default=".") + call get_param(PF, mdl, "INPUTDIR", inputdir, default=".") inputdir = slasher(inputdir) ! GM: get two different files, one with temp and one with salt values ! this is work around to avoid having wrong values near the surface ! because of the FIT_SALINITY option. To get salt values right in the ! sponge, FIT_SALINITY=False. The oposite is true for temp. One can ! combined the *correct* temp and salt values in one file instead. - call get_param(PF, mod, "ISOMIP_SPONGE_FILE", state_file, & + call get_param(PF, mdl, "ISOMIP_SPONGE_FILE", state_file, & "The name of the file with temps., salts. and interfaces to \n"// & " damp toward.", fail_if_missing=.true.) - call get_param(PF, mod, "SPONGE_PTEMP_VAR", temp_var, & + call get_param(PF, mdl, "SPONGE_PTEMP_VAR", temp_var, & "The name of the potential temperature variable in \n"//& "SPONGE_STATE_FILE.", default="Temp") - call get_param(PF, mod, "SPONGE_SALT_VAR", salt_var, & + call get_param(PF, mdl, "SPONGE_SALT_VAR", salt_var, & "The name of the salinity variable in \n"//& "SPONGE_STATE_FILE.", default="Salt") - call get_param(PF, mod, "SPONGE_ETA_VAR", eta_var, & + call get_param(PF, mdl, "SPONGE_ETA_VAR", eta_var, & "The name of the interface height variable in \n"//& "SPONGE_STATE_FILE.", default="eta") diff --git a/src/user/Kelvin_initialization.F90 b/src/user/Kelvin_initialization.F90 index 00491f43cb..a211f1cfc6 100644 --- a/src/user/Kelvin_initialization.F90 +++ b/src/user/Kelvin_initialization.F90 @@ -65,7 +65,7 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) type(Kelvin_OBC_CS), pointer :: CS !< Kelvin wave control structure. type(OBC_registry_type), pointer :: OBC_Reg !< OBC registry. logical :: register_Kelvin_OBC - character(len=40) :: mod = "register_Kelvin_OBC" !< This subroutine's name. + character(len=40) :: mdl = "register_Kelvin_OBC" !< This subroutine's name. character(len=32) :: casename = "Kelvin wave" !< This case's name. character(len=200) :: config @@ -76,30 +76,30 @@ function register_Kelvin_OBC(param_file, CS, OBC_Reg) endif allocate(CS) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "KELVIN_WAVE_MODE", CS%mode, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "KELVIN_WAVE_MODE", CS%mode, & "Vertical Kelvin wave mode imposed at upstream open boundary.", & default=0) - call get_param(param_file, mod, "F_0", CS%F_0, & + call get_param(param_file, mdl, "F_0", CS%F_0, & default=0.0, do_not_log=.true.) - call get_param(param_file, mod, "TOPO_CONFIG", config, do_not_log=.true.) + call get_param(param_file, mdl, "TOPO_CONFIG", config, do_not_log=.true.) if (trim(config) == "Kelvin") then - call get_param(param_file, mod, "KELVIN_COAST_OFFSET", CS%coast_offset, & + call get_param(param_file, mdl, "KELVIN_COAST_OFFSET", CS%coast_offset, & "The distance along the southern and northern boundaries \n"//& "at which the coasts angle in.", & units="km", default=100.0) - call get_param(param_file, mod, "KELVIN_COAST_ANGLE", CS%coast_angle, & + call get_param(param_file, mdl, "KELVIN_COAST_ANGLE", CS%coast_angle, & "The angle of the southern bondary beyond X=KELVIN_COAST_OFFSET.", & units="degrees", default=11.3) CS%coast_angle = CS%coast_angle * (atan(1.0)/45.) ! Convert to radians CS%coast_offset = CS%coast_offset * 1.e3 ! Convert to m endif if (CS%mode /= 0) then - call get_param(param_file, mod, "DENSITY_RANGE", CS%rho_range, & + call get_param(param_file, mdl, "DENSITY_RANGE", CS%rho_range, & default=2.0, do_not_log=.true.) - call get_param(param_file, mod, "RHO_0", CS%rho_0, & + call get_param(param_file, mdl, "RHO_0", CS%rho_0, & default=1035.0, do_not_log=.true.) - call get_param(param_file, mod, "MAXIMUM_DEPTH", CS%H0, & + call get_param(param_file, mdl, "MAXIMUM_DEPTH", CS%H0, & default=1000.0, do_not_log=.true.) endif @@ -126,7 +126,7 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m ! Local variables - character(len=40) :: mod = "Kelvin_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "Kelvin_initialize_topography" ! This subroutine's name. real :: min_depth ! The minimum and maximum depths in m. real :: PI ! 3.1415... real :: coast_offset, coast_angle, right_angle @@ -134,11 +134,11 @@ subroutine Kelvin_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" Kelvin_initialization.F90, Kelvin_initialize_topography: setting topography", 5) - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - call get_param(param_file, mod, "KELVIN_COAST_OFFSET", coast_offset, & + call get_param(param_file, mdl, "KELVIN_COAST_OFFSET", coast_offset, & default=100.0, do_not_log=.true.) - call get_param(param_file, mod, "KELVIN_COAST_ANGLE", coast_angle, & + call get_param(param_file, mdl, "KELVIN_COAST_ANGLE", coast_angle, & default=11.3, do_not_log=.true.) coast_angle = coast_angle * (atan(1.0)/45.) ! Convert to radians diff --git a/src/user/MOM_controlled_forcing.F90 b/src/user/MOM_controlled_forcing.F90 index 4ebec25a2d..d91d06dcc1 100644 --- a/src/user/MOM_controlled_forcing.F90 +++ b/src/user/MOM_controlled_forcing.F90 @@ -505,7 +505,7 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) integer :: num_cycle ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "MOM_controlled_forcing" ! This module's name. + character(len=40) :: mdl = "MOM_controlled_forcing" ! This module's name. ! These should have already been called. ! call read_param(param_file, "CTRL_FORCE_INTEGRATED", CS%do_integrated) @@ -518,12 +518,12 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) endif ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call log_param(param_file, mod, "CTRL_FORCE_INTEGRATED", do_integrated, & + call log_version(param_file, mdl, version, "") + call log_param(param_file, mdl, "CTRL_FORCE_INTEGRATED", do_integrated, & "If true, use a PI controller to determine the surface \n"//& "forcing that is consistent with the observed mean properties.", & default=.false.) - call log_param(param_file, mod, "CTRL_FORCE_NUM_CYCLE", num_cycle, & + call log_param(param_file, mdl, "CTRL_FORCE_NUM_CYCLE", num_cycle, & "The number of cycles per year in the controlled forcing, \n"//& "or 0 for no cyclic forcing.", default=0) @@ -531,32 +531,32 @@ subroutine controlled_forcing_init(Time, G, param_file, diag, CS) CS%diag => diag - call get_param(param_file, mod, "CTRL_FORCE_HEAT_INT_RATE", CS%heat_int_rate, & + call get_param(param_file, mdl, "CTRL_FORCE_HEAT_INT_RATE", CS%heat_int_rate, & "The integrated rate at which heat flux anomalies are \n"//& "accumulated.", units="s-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_PREC_INT_RATE", CS%prec_int_rate, & + call get_param(param_file, mdl, "CTRL_FORCE_PREC_INT_RATE", CS%prec_int_rate, & "The integrated rate at which precipitation anomalies \n"//& "are accumulated.", units="s-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_HEAT_CYC_RATE", CS%heat_cyc_rate, & + call get_param(param_file, mdl, "CTRL_FORCE_HEAT_CYC_RATE", CS%heat_cyc_rate, & "The integrated rate at which cyclical heat flux \n"//& "anomalies are accumulated.", units="s-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_PREC_CYC_RATE", CS%prec_cyc_rate, & + call get_param(param_file, mdl, "CTRL_FORCE_PREC_CYC_RATE", CS%prec_cyc_rate, & "The integrated rate at which cyclical precipitation \n"//& "anomalies are accumulated.", units="s-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_SMOOTH_LENGTH", smooth_len, & + call get_param(param_file, mdl, "CTRL_FORCE_SMOOTH_LENGTH", smooth_len, & "The length scales over which controlled forcing \n"//& "anomalies are smoothed.", units="m", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_LAMDA_HEAT", CS%lam_heat, & + call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_HEAT", CS%lam_heat, & "A constant of proportionality between SST anomalies \n"//& "and controlling heat fluxes", "W m-2 K-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_LAMDA_PREC", CS%lam_prec, & + call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_PREC", CS%lam_prec, & "A constant of proportionality between SSS anomalies \n"//& "(normalised by mean SSS) and controlling precipitation.", & "kg m-2", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_LAMDA_CYC_HEAT", CS%lam_cyc_heat, & + call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_HEAT", CS%lam_cyc_heat, & "A constant of proportionality between SST anomalies \n"//& "and cyclical controlling heat fluxes", "W m-2 K-1", default=0.0) - call get_param(param_file, mod, "CTRL_FORCE_LAMDA_CYC_PREC", CS%lam_cyc_prec, & + call get_param(param_file, mdl, "CTRL_FORCE_LAMDA_CYC_PREC", CS%lam_cyc_prec, & "A constant of proportionality between SSS anomalies \n"//& "(normalised by mean SSS) and cyclical controlling \n"//& "precipitation.", "kg m-2", default=0.0) diff --git a/src/user/Phillips_initialization.F90 b/src/user/Phillips_initialization.F90 index bcbc55b559..704c332743 100644 --- a/src/user/Phillips_initialization.F90 +++ b/src/user/Phillips_initialization.F90 @@ -48,14 +48,15 @@ module Phillips_initialization contains !> Initialize thickness field. -subroutine Phillips_initialize_thickness(h, G, GV, param_file) +subroutine Phillips_initialize_thickness(h, G, GV, param_file, just_read_params) 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(out) :: h !< The thickness that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. + intent(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: eta0(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: eta_im(SZJ_(G),SZK_(G)+1) ! A temporary array for zonal-mean eta, m. @@ -63,7 +64,8 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file) ! positive upward, in m. real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth - character(len=40) :: mod = "Phillips_initialize_thickness" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "Phillips_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke @@ -71,17 +73,21 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file) eta_im(:,:) = 0.0 - call log_version(param_file, mod, version) - call get_param(param_file, mod, "HALF_STRAT_DEPTH", half_strat, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The maximum depth of the ocean.", units="nondim", & - default = 0.5) - call get_param(param_file, mod, "JET_WIDTH", jet_width, & + default = 0.5, do_not_log=just_read) + call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & - fail_if_missing=.true.) - call get_param(param_file, mod, "JET_HEIGHT", jet_height, & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& "zonal-mean jet.", units="m", & - fail_if_missing=.true.) + fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. half_depth = G%max_depth*half_strat eta0(1) = 0.0 ; eta0(nz+1) = -G%max_depth @@ -123,37 +129,45 @@ subroutine Phillips_initialize_thickness(h, G, GV, param_file) end subroutine Phillips_initialize_thickness !> Initialize velocity fields. -subroutine Phillips_initialize_velocity(u, v, G, GV, param_file) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m/s] - real, dimension(SZI_(G),SZJB_(G),SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] - type(param_file_type), intent(in) :: param_file !< A structure indicating - !! the open file to parse for model - !! parameter values. +subroutine Phillips_initialize_velocity(u, v, G, GV, param_file, just_read_params) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), & + intent(out) :: u !< i-component of velocity [m/s] + real, dimension(SZI_(G),SZJB_(G),SZK_(G)), & + intent(out) :: v !< j-component of velocity [m/s] + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to + !! parse for modelparameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: damp_rate, jet_width, jet_height, x_2, y_2 real :: velocity_amplitude, pi integer :: i, j, k, is, ie, js, je, nz, m - character(len=40) :: mod = "Phillips_initialize_velocity" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "Phillips_initialize_velocity" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - u(:,:,:) = 0.0 - v(:,:,:) = 0.0 - - pi = 4.0*atan(1.0) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call log_version(param_file, mod, version) - call get_param(param_file, mod, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & + if (.not.just_read) call log_version(param_file, mdl, version) + call get_param(param_file, mdl, "VELOCITY_IC_PERTURB_AMP", velocity_amplitude, & "The magnitude of the initial velocity perturbation.", & - units="m s-1", default=0.001) - call get_param(param_file, mod, "JET_WIDTH", jet_width, & + units="m s-1", default=0.001, do_not_log=just_read) + call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & - fail_if_missing=.true.) - call get_param(param_file, mod, "JET_HEIGHT", jet_height, & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& "zonal-mean jet.", units="m", & - fail_if_missing=.true.) + fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + + u(:,:,:) = 0.0 + v(:,:,:) = 0.0 + + pi = 4.0*atan(1.0) ! Use thermal wind shear to give a geostrophically balanced flow. do k=nz-1,1 ; do j=js,je ; do I=is-1,ie @@ -215,7 +229,7 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, real :: Idamp_im(SZJ_(G)) ! The inverse zonal-mean damping rate, in s-1. real :: damp_rate, jet_width, jet_height, y_2 real :: half_strat, half_depth - character(len=40) :: mod = "Phillips_initialize_sponges" ! This subroutine's name. + character(len=40) :: mdl = "Phillips_initialize_sponges" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz logical, save :: first_call = .true. @@ -226,19 +240,19 @@ subroutine Phillips_initialize_sponges(G, use_temperature, tv, param_file, CSp, eta(:,:,:) = 0.0 ; temp(:,:,:) = 0.0 ; Idamp(:,:) = 0.0 eta_im(:,:) = 0.0 ; Idamp_im(:) = 0.0 - if (first_call) call log_version(param_file, mod, version) + if (first_call) call log_version(param_file, mdl, version) first_call = .false. - call get_param(param_file, mod, "HALF_STRAT_DEPTH", half_strat, & + call get_param(param_file, mdl, "HALF_STRAT_DEPTH", half_strat, & "The maximum depth of the ocean.", units="nondim", & default = 0.5) - call get_param(param_file, mod, "SPONGE_RATE", damp_rate, & + call get_param(param_file, mdl, "SPONGE_RATE", damp_rate, & "The rate at which the zonal-mean sponges damp.", units="s-1", & default = 1.0/(10.0*86400.0)) - call get_param(param_file, mod, "JET_WIDTH", jet_width, & + call get_param(param_file, mdl, "JET_WIDTH", jet_width, & "The width of the zonal-mean jet.", units="km", & fail_if_missing=.true.) - call get_param(param_file, mod, "JET_HEIGHT", jet_height, & + call get_param(param_file, mdl, "JET_HEIGHT", jet_height, & "The interface height scale associated with the \n"//& "zonal-mean jet.", units="m", & fail_if_missing=.true.) @@ -291,13 +305,13 @@ subroutine Phillips_initialize_topography(D, G, param_file, max_depth) real :: PI, Htop, Wtop, Ltop, offset, dist, & x1, x2, x3, x4, y1, y2 integer :: i,j,is,ie,js,je - character(len=40) :: mod = "Phillips_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "Phillips_initialize_topography" ! This subroutine's name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec PI = 4.0*atan(1.0) - call get_param(param_file, mod, "PHILLIPS_HTOP", Htop, & + call get_param(param_file, mdl, "PHILLIPS_HTOP", Htop, & "The maximum height of the topography.", units="m", & fail_if_missing=.true.) ! Htop=0.375*G%max_depth ! max height of topog. above max_depth @@ -356,19 +370,10 @@ end subroutine Phillips_initialize_topography !! in MOM_surface_forcing.F90. * !! * !! These variables are all set in the set of subroutines (in this * -!! file) USER_initialize_bottom_depth, USER_initialize_thickness, * -!! USER_initialize_velocity, USER_initialize_temperature_salinity, * -!! USER_initialize_mixed_layer_density, USER_initialize_sponges, * -!! USER_set_coord, and USER_set_ref_profile. * -!! * -!! The names of these subroutines should be self-explanatory. They * -!! start with "USER_" to indicate that they will likely have to be * -!! modified for each simulation to set the initial conditions and * -!! boundary conditions. Most of these take two arguments: an integer * -!! argument specifying whether the fields are to be calculated * -!! internally or read from a NetCDF file; and a string giving the * -!! path to that file. If the field is initialized internally, the * -!! path is ignored. * +!! file) Phillips_initialize_thickness, Phillips_initialize_velocity, * +!! Phillips_initialize_topography and Phillips_initialize_sponges * +!! that seet up fields that are specific to the Phillips instability * +!! test case. * !! * !! Macros written all in capital letters are defined in MOM_memory.h. * !! * diff --git a/src/user/Rossby_front_2d_initialization.F90 b/src/user/Rossby_front_2d_initialization.F90 index d32ad1d6a7..43bca2f117 100644 --- a/src/user/Rossby_front_2d_initialization.F90 +++ b/src/user/Rossby_front_2d_initialization.F90 @@ -22,7 +22,9 @@ module Rossby_front_2d_initialization #include ! Private (module-wise) parameters -character(len=40) :: mod = "Rossby_front_2d_initialization" !< This module's name. +character(len=40) :: mdl = "Rossby_front_2d_initialization" !< This module's name. +! This include declares and sets the variable "version". +#include "version_variable.h" public Rossby_front_initialize_thickness public Rossby_front_initialize_temperature_salinity @@ -36,28 +38,40 @@ module Rossby_front_2d_initialization contains !> Initialization of thicknesses in 2D Rossby front test -subroutine Rossby_front_initialize_thickness(h, G, GV, param_file ) - type(ocean_grid_type), intent(in) :: G !< Grid structure - type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure - real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: h !< Thickness - type(param_file_type), intent(in) :: param_file !< Parameter file handle +subroutine Rossby_front_initialize_thickness(h, G, GV, param_file, just_read_params) + type(ocean_grid_type), intent(in) :: G !< Grid structure + type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure + real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), & + intent(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: Tz, Dml, eta, stretch, h0 real :: min_thickness, T_range, dRho_dT + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg("Rossby_front_2d_initialization.F90, Rossby_front_initialize_thickness: setting thickness") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + if (.not.just_read) & + call MOM_mesg("Rossby_front_2d_initialization.F90, Rossby_front_initialize_thickness: setting thickness") + + if (.not.just_read) call log_version(param_file, mdl, version, "") ! Read parameters needed to set thickness - call get_param(param_file, mod, "MIN_THICKNESS", min_thickness, & - 'Minimum layer thickness',units='m',default=1.e-3) - call get_param(param_file, mod, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file, mod, "T_RANGE", T_range, 'Initial temperature range', units='C', default=0.0) - call get_param(param_file, mod, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + call get_param(param_file, mdl, "MIN_THICKNESS", min_thickness, & + 'Minimum layer thickness',units='m',default=1.e-3, do_not_log=just_read) + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & + units='C', default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + + if (just_read) return ! All run-time parameters have been read, so return. Tz = T_range / G%max_depth @@ -95,28 +109,39 @@ end subroutine Rossby_front_initialize_thickness !> Initialization of temperature and salinity in the Rossby front test -subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, param_file, eqn_of_state) +subroutine Rossby_front_initialize_temperature_salinity(T, S, h, G, & + param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness type(param_file_type), intent(in) :: param_file !< Parameter file handle type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, S_ref ! Reference salinity and temerature within surface layer real :: T_range ! Range of salinities and temperatures over the vertical real :: y, zc, zi, dTdz + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate real :: PI ! 3.1415926... calculated as 4*atan(1) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file,mod,"S_REF",S_ref,'Reference salinity',units='1e-3',fail_if_missing=.true.) - call get_param(param_file,mod,"T_REF",T_ref,'Reference temperature',units='C',fail_if_missing=.true.) - call get_param(param_file,mod,"T_RANGE",T_range,'Initial temperature range',units='C',default=0.0) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl,"S_REF",S_ref,'Reference salinity', units='1e-3', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C',& + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range',& + units='C', default=0.0, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. T(:,:,:) = 0.0 S(:,:,:) = S_ref @@ -136,7 +161,7 @@ end subroutine Rossby_front_initialize_temperature_salinity !> Initialization of u and v in the Rossby front test -subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file) +subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZIB_(G),SZJ_(G),SZK_(G)), intent(out) :: u !< i-component of velocity [m/s] @@ -145,20 +170,28 @@ subroutine Rossby_front_initialize_velocity(u, v, h, G, GV, param_file) type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: y ! Non-dimensional coordinate across channel, 0..pi real :: T_range ! Range of salinities and temperatures over the vertical real :: dUdT ! Factor to convert dT/dy into dU/dz, g*alpha/f real :: dRho_dT, zi, zc, zm, f, Ty, Dml, hAtU integer :: i, j, k, is, ie, js, je, nz + logical :: just_read ! If true, just read parameters but set nothing. character(len=40) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call get_param(param_file, mod, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file, mod, "T_RANGE", T_range, 'Initial temperature range', units='C', default=0.0) - call get_param(param_file, mod, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl, "T_RANGE", T_range, 'Initial temperature range', & + units='C', default=0.0, do_not_log=just_read) + call get_param(param_file, mdl, "DRHO_DT", dRho_dT, default=-0.2, do_not_log=.true.) + + if (just_read) return ! All run-time parameters have been read, so return. v(:,:,:) = 0.0 u(:,:,:) = 0.0 diff --git a/src/user/SCM_CVmix_tests.F90 b/src/user/SCM_CVmix_tests.F90 index 3c39776a07..bd135c5046 100644 --- a/src/user/SCM_CVmix_tests.F90 +++ b/src/user/SCM_CVmix_tests.F90 @@ -41,18 +41,20 @@ module SCM_CVmix_tests ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mod = "SCM_CVmix_tests" ! This module's name. +character(len=40) :: mdl = "SCM_CVmix_tests" ! This module's name. contains !> Initializes temperature and salinity for the SCM CVmix test example -subroutine SCM_CVmix_tests_TS_init(T, S, h, G, GV, param_file) +subroutine SCM_CVmix_tests_TS_init(T, S, h, G, GV, param_file, just_read_params) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: T !< Potential tempera\ture (degC) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(out) :: S !< Salinity (psu) real, dimension(NIMEM_,NJMEM_, NKMEM_), intent(in) :: h !< Layer thickness (m or Pa) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV!< Vertical grid structure type(param_file_type), intent(in) :: param_file !< Input parameter structure + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Local variables real :: eta(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: UpperLayerTempMLD !< Upper layer Temp MLD thickness (m) @@ -64,31 +66,36 @@ subroutine SCM_CVmix_tests_TS_init(T, S, h, G, GV, param_file) real :: LowerLayerdTdz !< Temp gradient in lower layer (deg C m^{-1}) real :: LowerLayerdSdz !< Salt gradient in lower layer (PPT m^{-1}) real :: zC, DZ + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call log_version(param_file, mod, version) - call get_param(param_file,mod,"SCM_TEMP_MLD",UpperLayerTempMLD, & - 'Initial temp mixed layer depth', units='m',default=0.0) - call get_param(param_file,mod,"SCM_SALT_MLD",UpperLayerSaltMLD, & - 'Initial salt mixed layer depth', units='m',default=0.0) - call get_param(param_file,mod,"SCM_L1_SALT",UpperLayerSalt, & - 'Layer 2 surface salinity', units='1e-3',default=35.0) - call get_param(param_file,mod,"SCM_L1_TEMP",UpperLayerTemp, & - 'Layer 1 surface temperature', units='C', default=20.0) - call get_param(param_file,mod,"SCM_L2_SALT",LowerLayerSalt, & - 'Layer 2 surface salinity', units='1e-3',default=35.0) - call get_param(param_file,mod,"SCM_L2_TEMP",LowerLayerTemp, & - 'Layer 2 surface temperature', units='C', default=20.0) - call get_param(param_file,mod,"SCM_L2_DTDZ",LowerLayerdTdZ, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) call log_version(param_file, mdl, version) + call get_param(param_file, mdl,"SCM_TEMP_MLD",UpperLayerTempMLD, & + 'Initial temp mixed layer depth', units='m',default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_SALT_MLD",UpperLayerSaltMLD, & + 'Initial salt mixed layer depth', units='m',default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L1_SALT",UpperLayerSalt, & + 'Layer 2 surface salinity', units='1e-3',default=35.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L1_TEMP",UpperLayerTemp, & + 'Layer 1 surface temperature', units='C', default=20.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L2_SALT",LowerLayerSalt, & + 'Layer 2 surface salinity', units='1e-3',default=35.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L2_TEMP",LowerLayerTemp, & + 'Layer 2 surface temperature', units='C', default=20.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L2_DTDZ",LowerLayerdTdZ, & 'Initial temperature stratification in layer 2', & - units='C/m', default=0.00) - call get_param(param_file,mod,"SCM_L2_DSDZ",LowerLayerdSdZ, & + units='C/m', default=0.00, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_L2_DSDZ",LowerLayerdSdZ, & 'Initial salinity stratification in layer 2', & - units='PPT/m', default=0.00) + units='PPT/m', default=0.00, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta(1) = 0. ! Reference to surface @@ -130,47 +137,47 @@ subroutine SCM_CVmix_tests_surface_forcing_init(Time, G, param_file, CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "SCM_USE_WIND_STRESS", & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SCM_USE_WIND_STRESS", & CS%UseWindStress, "Wind Stress switch "// & "used in the SCM CVmix surface forcing.", & units='', default=.false.) - call get_param(param_file, mod, "SCM_USE_HEAT_FLUX", & + call get_param(param_file, mdl, "SCM_USE_HEAT_FLUX", & CS%UseHeatFlux, "Heat flux switch "// & "used in the SCM CVmix test surface forcing.", & units='', default=.false.) - call get_param(param_file, mod, "SCM_USE_EVAPORATION", & + call get_param(param_file, mdl, "SCM_USE_EVAPORATION", & CS%UseEvaporation, "Evaporation switch "// & "used in the SCM CVmix test surface forcing.", & units='', default=.false.) - call get_param(param_file, mod, "SCM_USE_DIURNAL_SW", & + call get_param(param_file, mdl, "SCM_USE_DIURNAL_SW", & CS%UseDiurnalSW, "Diurnal sw radation switch "// & "used in the SCM CVmix test surface forcing.", & units='', default=.false.) if (CS%UseWindStress) then - call get_param(param_file, mod, "SCM_TAU_X", & + call get_param(param_file, mdl, "SCM_TAU_X", & CS%tau_x, "Constant X-dir wind stress "// & "used in the SCM CVmix test surface forcing.", & units='N/m2', fail_if_missing=.true.) - call get_param(param_file, mod, "SCM_TAU_Y", & + call get_param(param_file, mdl, "SCM_TAU_Y", & CS%tau_y, "Constant y-dir wind stress "// & "used in the SCM CVmix test surface forcing.", & units='N/m2', fail_if_missing=.true.) endif if (CS%UseHeatFlux) then - call get_param(param_file, mod, "SCM_HEAT_FLUX", & + call get_param(param_file, mdl, "SCM_HEAT_FLUX", & CS%surf_HF, "Constant surface heat flux "// & "used in the SCM CVmix test surface forcing.", & units='m K/s', fail_if_missing=.true.) endif if (CS%UseEvaporation) then - call get_param(param_file, mod, "SCM_EVAPORATION", & + call get_param(param_file, mdl, "SCM_EVAPORATION", & CS%surf_evap, "Constant surface evaporation "// & "used in the SCM CVmix test surface forcing.", & units='m/s', fail_if_missing=.true.) endif if (CS%UseDiurnalSW) then - call get_param(param_file, mod, "SCM_DIURNAL_SW_MAX", & + call get_param(param_file, mdl, "SCM_DIURNAL_SW_MAX", & CS%Max_sw, "Maximum diurnal sw radiation "// & "used in the SCM CVmix test surface forcing.", & units='m K/s', fail_if_missing=.true.) diff --git a/src/user/SCM_idealized_hurricane.F90 b/src/user/SCM_idealized_hurricane.F90 index d383f7150e..79ea766017 100644 --- a/src/user/SCM_idealized_hurricane.F90 +++ b/src/user/SCM_idealized_hurricane.F90 @@ -39,37 +39,46 @@ module SCM_idealized_hurricane ! This include declares and sets the variable "version". #include "version_variable.h" -character(len=40) :: mod = "SCM_idealized_hurricane" ! This module's name. +character(len=40) :: mdl = "SCM_idealized_hurricane" ! This module's name. contains !> Initializes temperature and salinity for the SCM idealized hurricane example -subroutine SCM_idealized_hurricane_TS_init(T, S, h, G, GV, param_file) +subroutine SCM_idealized_hurricane_TS_init(T, S, h, G, GV, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (psu) real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness (m or Pa) type(param_file_type), intent(in) :: param_file !< Input parameter structure + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. ! Local variables real :: eta(SZK_(G)+1) ! The 1-d nominal positions of the interfaces. real :: S_ref, SST_ref, dTdZ, MLD real :: zC + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed - call log_version(param_file, mod, version) - call get_param(param_file,mod,"SCM_S_REF",S_ref, & - 'Reference salinity', units='1e-3',default=35.0) - call get_param(param_file,mod,"SCM_SST_REF",SST_ref, & - 'Reference surface temperature', units='C', fail_if_missing=.true.) - call get_param(param_file,mod,"SCM_DTDZ",dTdZ, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) call log_version(param_file, mdl, version) + call get_param(param_file, mdl,"SCM_S_REF",S_ref, & + 'Reference salinity', units='1e-3',default=35.0, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_SST_REF",SST_ref, & + 'Reference surface temperature', units='C', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_DTDZ",dTdZ, & 'Initial temperature stratification below mixed layer', & - units='C/m', fail_if_missing=.true.) - call get_param(param_file,mod,"SCM_MLD",MLD, & - 'Initial mixed layer depth', units='m', fail_if_missing=.true.) + units='C/m', fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"SCM_MLD",MLD, & + 'Initial mixed layer depth', units='m', & + fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta(1) = 0. ! Reference to surface @@ -101,36 +110,36 @@ subroutine SCM_idealized_hurricane_wind_init(Time, G, param_file, CS) allocate(CS) ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "SCM_RHO_AIR", CS%rho_a, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SCM_RHO_AIR", CS%rho_a, & "Air density "// & "used in the SCM idealized hurricane wind profile.", & units='kg/m3', default=1.2) - call get_param(param_file, mod, "SCM_AMBIENT_PRESSURE", CS%p_n, & + call get_param(param_file, mdl, "SCM_AMBIENT_PRESSURE", CS%p_n, & "Ambient pressure "// & "used in the SCM idealized hurricane wind profile.", & units='Pa', default=101200.) - call get_param(param_file, mod, "SCM_CENTRAL_PRESSURE", CS%p_c, & + call get_param(param_file, mdl, "SCM_CENTRAL_PRESSURE", CS%p_c, & "Central pressure "// & "used in the SCM idealized hurricane wind profile.", & units='Pa', default=96800.) - call get_param(param_file, mod, "SCM_RADIUS_MAX_WINDS", CS%r_max, & + call get_param(param_file, mdl, "SCM_RADIUS_MAX_WINDS", CS%r_max, & "Radius of maximum winds "// & "used in the SCM idealized hurricane wind profile.", & units='m', default=50.e3) - call get_param(param_file, mod, "SCM_MAX_WIND_SPEED", CS%U_max, & + call get_param(param_file, mdl, "SCM_MAX_WIND_SPEED", CS%U_max, & "Maximum wind speed "// & "used in the SCM idealized hurricane wind profile.", & units='m/s', default=65.) - call get_param(param_file, mod, "SCM_YY", CS%YY, & + call get_param(param_file, mdl, "SCM_YY", CS%YY, & "Y distance of station "// & "used in the SCM idealized hurricane wind profile.", & units='m', default=50.e3) - call get_param(param_file, mod, "SCM_TRAN_SPEED", CS%TRAN_SPEED, & + call get_param(param_file, mdl, "SCM_TRAN_SPEED", CS%TRAN_SPEED, & "Translation speed of hurricane"// & "used in the SCM idealized hurricane wind profile.", & units='m/s', default=5.0) - call get_param(param_file, mod, "RHO_0", CS%Rho0, & + call get_param(param_file, mdl, "RHO_0", CS%Rho0, & "The mean ocean density used with BOUSSINESQ true to \n"//& "calculate accelerations and the mass for conservation \n"//& "properties, or with BOUSSINSEQ false to convert some \n"//& @@ -139,7 +148,7 @@ subroutine SCM_idealized_hurricane_wind_init(Time, G, param_file, CS) ! The following parameter is a model run-time parameter which is used ! and logged elsewhere and so should not be logged here. The default ! value should be consistent with the rest of the model. - call get_param(param_file, mod, "GUST_CONST", CS%gust_const, & + call get_param(param_file, mdl, "GUST_CONST", CS%gust_const, & "The background gustiness in the winds.", units="Pa", & default=0.00, do_not_log=.true.) diff --git a/src/user/adjustment_initialization.F90 b/src/user/adjustment_initialization.F90 index 8211d21d74..574b5b41b6 100644 --- a/src/user/adjustment_initialization.F90 +++ b/src/user/adjustment_initialization.F90 @@ -35,7 +35,7 @@ module adjustment_initialization implicit none ; private -character(len=40) :: mod = "adjustment_initialization" ! This module's name. +character(len=40) :: mdl = "adjustment_initialization" ! This module's name. #include @@ -54,55 +54,68 @@ module adjustment_initialization !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. !------------------------------------------------------------------------------ -subroutine adjustment_initialize_thickness ( h, G, GV, param_file ) +subroutine adjustment_initialize_thickness ( h, G, GV, param_file, just_read_params) - 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(out) :: h !< The thickness that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model parameter values. + type(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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! ! positive upward, in m. ! - integer :: i, j, k, is, ie, js, je, nz real :: x, y, yy, delta_S_strat, dSdz, delta_S, S_ref real :: min_thickness, adjustment_width, adjustment_delta, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym real :: target_values(SZK_(G)+1) + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "adjustment_initialization" ! This module's name. + integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg("initialize_thickness_uniform: setting thickness") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) & + call MOM_mesg("initialize_thickness_uniform: setting thickness") ! Parameters used by main model initialization - call get_param(param_file,mod,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) - call get_param(param_file,mod,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & - units='m',default=1.0e-3) + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl,"S_REF",S_ref,fail_if_missing=.true.,do_not_log=.true.) + call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness,'Minimum layer thickness', & + units='m',default=1.0e-3, do_not_log=just_read) ! Parameters specific to this experiment configuration - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file,mod,"ADJUSTMENT_WIDTH",adjustment_width, & + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl,"ADJUSTMENT_WIDTH",adjustment_width, & "Width of frontal zone", & - units="same as x,y",fail_if_missing=.true.) - call get_param(param_file,mod,"DELTA_S_STRAT",delta_S_strat, & + units="same as x,y", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"DELTA_S_STRAT",delta_S_strat, & "Top-to-bottom salinity difference of stratification", & - units="1e-3",fail_if_missing=.true.) - call get_param(param_file,mod,"ADJUSTMENT_DELTAS",adjustment_deltaS, & + units="1e-3", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"ADJUSTMENT_DELTAS",adjustment_deltaS, & "Salinity difference across front", & - units="1e-3",fail_if_missing=.true.) - call get_param(param_file,mod,"FRONT_WAVE_AMP",front_wave_amp, & + units="1e-3", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"FRONT_WAVE_AMP",front_wave_amp, & "Amplitude of trans-frontal wave perturbation", & - units="same as x,y",default=0.) - call get_param(param_file,mod,"FRONT_WAVE_LENGTH",front_wave_length, & + units="same as x,y",default=0., do_not_log=just_read) + call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & "Wave-length of trans-frontal wave perturbation", & - units="same as x,y",default=0.) - call get_param(param_file,mod,"FRONT_WAVE_ASYM",front_wave_asym, & + units="same as x,y",default=0., do_not_log=just_read) + call get_param(param_file, mdl,"FRONT_WAVE_ASYM",front_wave_asym, & "Amplitude of frontal asymmetric perturbation", & - default=0.) + default=0., do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. ! WARNING: this routine specifies the interface heights so that the last layer ! is vanished, even at maximum depth. In order to have a uniform @@ -195,7 +208,7 @@ end subroutine adjustment_initialize_thickness !> Initialization of temperature and salinity. !------------------------------------------------------------------------------ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, param_file, & - eqn_of_state) + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< The temperature that is being initialized. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< The salinity that is being initialized. @@ -203,6 +216,8 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, param_file, type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: x, y, yy @@ -215,26 +230,39 @@ subroutine adjustment_initialize_temperature_salinity ( T, S, h, G, param_file, real :: adjustment_width, adjustment_deltaS real :: front_wave_amp, front_wave_length, front_wave_asym real :: eta1d(SZK_(G)+1) + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + ! Parameters used by main model initialization - call get_param(param_file,mod,"S_REF",S_ref,'Reference salinity',units='1e-3',fail_if_missing=.true.) - call get_param(param_file,mod,"T_REF",T_ref,'Reference temperature',units='C',fail_if_missing=.true.) - call get_param(param_file,mod,"S_RANGE",S_range,'Initial salinity range',units='1e-3', & - default=2.0) - call get_param(param_file,mod,"T_RANGE",T_range,'Initial temperature range',units='C', & - default=0.0) + call get_param(param_file, mdl,"S_REF",S_ref,'Reference salinity', units='1e-3', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature', units='C', & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range', units='1e-3', & + default=2.0, do_not_log=just_read) + call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', units='C', & + default=0.0, do_not_log=just_read) ! Parameters specific to this experiment configuration BUT logged in previous s/r - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file,mod,"ADJUSTMENT_WIDTH",adjustment_width,fail_if_missing=.true.,do_not_log=.true.) - call get_param(param_file,mod,"ADJUSTMENT_DELTAS",adjustment_deltaS,fail_if_missing=.true.,do_not_log=.true.) - call get_param(param_file,mod,"DELTA_S_STRAT",delta_S_strat,fail_if_missing=.true.,do_not_log=.true.) - call get_param(param_file,mod,"FRONT_WAVE_AMP",front_wave_amp,default=0.,do_not_log=.true.) - call get_param(param_file,mod,"FRONT_WAVE_LENGTH",front_wave_length,default=0.,do_not_log=.true.) - call get_param(param_file,mod,"FRONT_WAVE_ASYM",front_wave_asym,default=0.,do_not_log=.true.) + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl,"ADJUSTMENT_WIDTH", adjustment_width, & + fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl,"ADJUSTMENT_DELTAS", adjustment_deltaS, & + fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl,"DELTA_S_STRAT", delta_S_strat, & + fail_if_missing=.not.just_read, do_not_log=.true.) + call get_param(param_file, mdl,"FRONT_WAVE_AMP", front_wave_amp, default=0., & + do_not_log=.true.) + call get_param(param_file, mdl,"FRONT_WAVE_LENGTH",front_wave_length, & + default=0.,do_not_log=.true.) + call get_param(param_file, mdl,"FRONT_WAVE_ASYM", front_wave_asym, default=0., & + do_not_log=.true.) + + if (just_read) return ! All run-time parameters have been read, so return. T(:,:,:) = 0.0 S(:,:,:) = 0.0 diff --git a/src/user/baroclinic_zone_initialization.F90 b/src/user/baroclinic_zone_initialization.F90 index 78c78f5e81..d90d9a4650 100644 --- a/src/user/baroclinic_zone_initialization.F90 +++ b/src/user/baroclinic_zone_initialization.F90 @@ -13,14 +13,15 @@ module baroclinic_zone_initialization #include "version_variable.h" ! Private (module-wise) parameters -character(len=40) :: mod = "baroclinic_zone_initialization" !< This module's name. +character(len=40) :: mdl = "baroclinic_zone_initialization" !< This module's name. public baroclinic_zone_init_temperature_salinity contains !> Reads the parameters unique to this module -subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone) +subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, & + delta_T, dTdx, L_zone, just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure type(param_file_type), intent(in) :: param_file !< Parameter file handle real, intent(out) :: S_ref !< Reference salinity (ppt) @@ -32,29 +33,47 @@ subroutine bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, de real, intent(out) :: delta_T !< Temperature difference across baroclinic zone (ppt) real, intent(out) :: dTdx !< Linear temperature gradient (ppt/m) real, intent(out) :: L_zone !< Width of baroclinic zone (m) + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + logical :: just_read ! If true, just read parameters but set nothing. - call log_version(param_file, mod, version, 'Initialization of an analytic baroclninic zone') + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (.not.just_read) & + call log_version(param_file, mdl, version, 'Initialization of an analytic baroclinic zone') call openParameterBlock(param_file,'BCZIC') - call get_param(param_file,mod,"S_REF",S_ref,'Reference salinity',units='ppt',default=35.) - call get_param(param_file,mod,"DSDZ",dSdz,'Salinity stratification',units='ppt/m',default=0.0) - call get_param(param_file,mod,"DELTA_S",delta_S,'Salinity difference across baroclinic zone',units='ppt',default=0.0) - call get_param(param_file,mod,"DSDX",dSdx,'Meridional salinity difference',units='ppt/'//trim(G%x_axis_units),default=0.0) - call get_param(param_file,mod,"T_REF",T_ref,'Reference temperature',units='C',default=10.) - call get_param(param_file,mod,"DTDZ",dTdz,'Temperature stratification',units='C/m',default=0.0) - call get_param(param_file,mod,"DELTA_T",delta_T,'Temperature difference across baroclinic zone',units='C',default=0.0) - call get_param(param_file,mod,"DTDX",dTdx,'Meridional temperature difference',units='C/'//trim(G%x_axis_units),default=0.0) - call get_param(param_file,mod,"L_ZONE",L_zone,'Width of baroclinic zone',units=G%x_axis_units,default=0.5*G%len_lat) + call get_param(param_file, mdl, "S_REF", S_ref, 'Reference salinity', units='ppt', & + default=35., do_not_log=just_read) + call get_param(param_file, mdl,"DSDZ",dSdz,'Salinity stratification',units='ppt/m', & + default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"DELTA_S",delta_S,'Salinity difference across baroclinic zone', & + units='ppt', default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"DSDX",dSdx,'Meridional salinity difference', & + units='ppt/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Reference temperature',units='C', & + default=10., do_not_log=just_read) + call get_param(param_file, mdl,"DTDZ",dTdz,'Temperature stratification',units='C/m', & + default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"DELTA_T",delta_T,'Temperature difference across baroclinic zone', & + units='C', default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"DTDX",dTdx,'Meridional temperature difference', & + units='C/'//trim(G%x_axis_units), default=0.0, do_not_log=just_read) + call get_param(param_file, mdl,"L_ZONE",L_zone,'Width of baroclinic zone', & + units=G%x_axis_units, default=0.5*G%len_lat, do_not_log=just_read) call closeParameterBlock(param_file) end subroutine bcz_params !> Initialization of temperature and salinity with the baroclinic zone initial conditions -subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, param_file) +subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, param_file, & + just_read_params) type(ocean_grid_type), intent(in) :: G !< Grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature [deg C] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity [ppt] real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Thickness type(param_file_type), intent(in) :: param_file !< Parameter file handle + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: T_ref, dTdz, dTdx, delta_T ! Parameters describing temperature distribution @@ -62,9 +81,14 @@ subroutine baroclinic_zone_init_temperature_salinity(T, S, h, G, param_file) real :: L_zone ! Width of baroclinic zone real :: zc, zi, x, xd, xs, y, yd, fn real :: PI ! 3.1415926... calculated as 4*atan(1) + logical :: just_read ! If true, just read parameters but set nothing. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call bcz_params(G, param_file, S_ref, dSdz, delta_S, dSdx, T_ref, dTdz, delta_T, dTdx, L_zone, just_read_params) + + if (just_read) return ! All run-time parameters have been read, so return. T(:,:,:) = 0. S(:,:,:) = 0. diff --git a/src/user/benchmark_initialization.F90 b/src/user/benchmark_initialization.F90 index d00e061997..48d56dd2cc 100644 --- a/src/user/benchmark_initialization.F90 +++ b/src/user/benchmark_initialization.F90 @@ -57,15 +57,15 @@ subroutine benchmark_initialize_topography(D, G, param_file, max_depth) real :: x, y ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "benchmark_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "benchmark_initialize_topography" ! This subroutine's name. integer :: i, j, is, ie, js, je, isd, ied, jsd, jed is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) PI = 4.0*atan(1.0) @@ -91,30 +91,32 @@ end subroutine benchmark_initialize_topography !! by finding the depths of interfaces in a specified latitude-dependent !! temperature profile with an exponentially decaying thermocline on top of a !! linear stratification. -subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ref) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thickness that is being - !! initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open - !! file to parse for model - !! parameter values. - type(EOS_type), pointer :: eqn_of_state !< integer that selects the - !! equation of state. - real, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure in Pa. - - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(G)+1) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(G)+1) ! Interface height relative to the sea surface ! - ! positive upward, in m. ! +subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, & + P_ref, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + type(EOS_type), pointer :: eqn_of_state !< integer that selects the + !! equation of state. + real, intent(in) :: P_Ref !< The coordinate-density + !! reference pressure in Pa. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real :: e_pert(SZK_(GV)+1) ! Interface height perturbations, positive ! + ! upward, in m. ! + real :: eta1D(SZK_(GV)+1) ! Interface height relative to the sea surface ! + ! positive upward, in m. ! real :: SST ! The initial sea surface temperature, in deg C. real :: T_int ! The initial temperature of an interface, in deg C. real :: ML_depth ! The specified initial mixed layer depth, in m. real :: thermocline_scale ! The e-folding scale of the thermocline, in m. - real, dimension(SZK_(G)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS + real, dimension(SZK_(GV)) :: T0, pres, S0, rho_guess, drho, drho_dT, drho_dS real :: a_exp ! The fraction of the overall stratification that is exponential. real :: I_ts, I_md ! Inverse lengthscales in m-1. real :: T_frac ! A ratio of the interface temperature to the range @@ -122,11 +124,16 @@ subroutine benchmark_initialize_thickness(h, G, GV, param_file, eqn_of_state, P_ real :: err, derr_dz ! The error between the profile's temperature and the ! interface temperature for a given z and its derivative. real :: pi, z - character(len=40) :: mod = "benchmark_initialize_thickness" ! This subroutine's name. + logical :: just_read + character(len=40) :: mdl = "benchmark_initialize_thickness" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! This subroutine has no run-time parameters. + call MOM_mesg(" benchmark_initialization.F90, benchmark_initialize_thickness: setting thickness", 5) k1 = GV%nk_rho_varies + 1 @@ -209,7 +216,7 @@ end subroutine benchmark_initialize_thickness !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & - eqn_of_state, P_Ref) + eqn_of_state, P_Ref, just_read_params) 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(out) :: T !< The potential temperature @@ -223,6 +230,8 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & !! equation of state. real, intent(in) :: P_Ref !< The coordinate-density !! reference pressure in Pa. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: T0(SZK_(G)), S0(SZK_(G)) real :: pres(SZK_(G)) ! Reference pressure in kg m-3. ! @@ -234,11 +243,16 @@ subroutine benchmark_init_temperature_salinity(T, S, G, GV, param_file, & real :: PI ! 3.1415926... calculated as 4*atan(1) real :: SST ! The initial sea surface temperature, in deg C. real :: lat - character(len=40) :: mod = "benchmark_init_temperature_salinity" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "benchmark_init_temperature_salinity" ! This subroutine's name. integer :: i, j, k, k1, is, ie, js, je, nz, itt is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! All run-time parameters have been read, so return. + k1 = GV%nk_rho_varies + 1 do k=1,nz diff --git a/src/user/circle_obcs_initialization.F90 b/src/user/circle_obcs_initialization.F90 index 6190bdaad2..857ded9d93 100644 --- a/src/user/circle_obcs_initialization.F90 +++ b/src/user/circle_obcs_initialization.F90 @@ -38,33 +38,42 @@ module circle_obcs_initialization contains !> This subroutine initializes layer thicknesses for the circle_obcs experiment. -subroutine circle_obcs_initialize_thickness(h, G, GV, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< The thickness that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open - !! file to parse for model parameter values. - - real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! +subroutine circle_obcs_initialize_thickness(h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + real :: e0(SZK_(GV)+1) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! + ! positive upward, in m. ! + real :: diskrad, rad, xCenter, xRadius, lonC, latC + logical :: just_read ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "circle_obcs_initialize_thickness" ! This module's name. + character(len=40) :: mdl = "circle_obcs_initialization" ! This module's name. integer :: i, j, k, is, ie, js, je, nz - real :: diskrad, rad, xCenter, xRadius, lonC, latC is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg(" circle_obcs_initialization.F90, circle_obcs_initialize_thickness: setting thickness", 5) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + if (.not.just_read) & + call MOM_mesg(" circle_obcs_initialization.F90, circle_obcs_initialize_thickness: setting thickness", 5) + + if (.not.just_read) call log_version(param_file, mdl, version, "") ! Parameters read by cartesian grid initialization - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "DISK_RADIUS", diskrad, & + call get_param(param_file, mdl, "DISK_RADIUS", diskrad, & "The radius of the initially elevated disk in the \n"//& "circle_obcs test case.", units=G%x_axis_units, & - fail_if_missing=.true.) + fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. do k=1,nz e0(K) = -G%max_depth * real(k-1) / real(nz) diff --git a/src/user/dense_water_initialization.F90 b/src/user/dense_water_initialization.F90 index 1cb86b63d7..06ecc498ac 100644 --- a/src/user/dense_water_initialization.F90 +++ b/src/user/dense_water_initialization.F90 @@ -20,7 +20,7 @@ module dense_water_initialization public dense_water_initialize_TS public dense_water_initialize_sponges -character(len=40) :: mod = "dense_water_initialization" +character(len=40) :: mdl = "dense_water_initialization" real, parameter :: default_sill = 0.2 !< Default depth of the sill [nondim] real, parameter :: default_shelf = 0.4 !< Default depth of the shelf [nondim] @@ -40,7 +40,7 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) integer :: i, j real :: x - call get_param(param_file, mod, "DENSE_WATER_DOMAIN_PARAMS", domain_params, & + call get_param(param_file, mdl, "DENSE_WATER_DOMAIN_PARAMS", domain_params, & "Fractional widths of all the domain sections for the dense water experiment.\n"//& "As a 5-element vector:\n"//& " - open ocean, the section at maximum depth\n"//& @@ -49,10 +49,10 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) " - upslope, the upward slope accumulating dense water\n"//& " - the shelf in the dense formation region.", & units="nondim", fail_if_missing=.true.) - call get_param(param_file, mod, "DENSE_WATER_SILL_DEPTH", sill_frac, & + call get_param(param_file, mdl, "DENSE_WATER_SILL_DEPTH", sill_frac, & "Depth of the sill separating downslope from upslope, as fraction of basin depth.", & units="nondim", default=default_sill) - call get_param(param_file, mod, "DENSE_WATER_SHELF_DEPTH", shelf_frac, & + call get_param(param_file, mdl, "DENSE_WATER_SHELF_DEPTH", shelf_frac, & "Depth of the shelf region accumulating dense water for overflow, as fraction of basin depth.", & units="nondim", default=default_shelf) @@ -89,27 +89,34 @@ subroutine dense_water_initialize_topography(D, G, param_file, max_depth) end subroutine dense_water_initialize_topography !> Initialize the temperature and salinity for the dense water experiment -subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h) +subroutine dense_water_initialize_TS(G, GV, param_file, eqn_of_state, T, S, h, just_read_params) type(ocean_grid_type), intent(in) :: G !< Horizontal grid control structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid control structure type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< EOS structure real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(out) :: T, S !< Output state real, dimension(SZI_(G),SZJ_(G),SZK_(GV)), intent(in) :: h !< Layer thicknesses + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: mld, S_ref, S_range, T_ref real :: zi, zmid + logical :: just_read ! If true, just read parameters but set nothing. integer :: i, j, k, nz nz = GV%ke - call get_param(param_file, mod, "DENSE_WATER_MLD", mld, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, & "Depth of unstratified mixed layer as a fraction of the water column.", & - units="nondim", default=default_mld) + units="nondim", default=default_mld, do_not_log=just_read) + + call get_param(param_file, mdl, "S_REF", S_ref, do_not_log=.true.) + call get_param(param_file, mdl, "S_RANGE", S_range, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, do_not_log=.true.) - call get_param(param_file, mod, "S_REF", S_ref, do_not_log=.true.) - call get_param(param_file, mod, "S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mod, "T_REF", T_ref, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. ! uniform temperature everywhere T(:,:,:) = T_ref @@ -159,29 +166,29 @@ subroutine dense_water_initialize_sponges(G, GV, tv, param_file, use_ALE, CSp, A nz = GV%ke - call get_param(param_file, mod, "DENSE_WATER_WEST_SPONGE_TIME_SCALE", west_sponge_time_scale, & + call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_TIME_SCALE", west_sponge_time_scale, & "The time scale on the west (outflow) of the domain for restoring. If zero, the sponge is disabled.", & units="s", default=0.) - call get_param(param_file, mod, "DENSE_WATER_WEST_SPONGE_WIDTH", west_sponge_width, & + call get_param(param_file, mdl, "DENSE_WATER_WEST_SPONGE_WIDTH", west_sponge_width, & "The fraction of the domain in which the western (outflow) sponge is active.", & units="nondim", default=0.1) - call get_param(param_file, mod, "DENSE_WATER_EAST_SPONGE_TIME_SCALE", east_sponge_time_scale, & + call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_TIME_SCALE", east_sponge_time_scale, & "The time scale on the east (outflow) of the domain for restoring. If zero, the sponge is disabled.", & units="s", default=0.) - call get_param(param_file, mod, "DENSE_WATER_EAST_SPONGE_WIDTH", east_sponge_width, & + call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_WIDTH", east_sponge_width, & "The fraction of the domain in which the eastern (outflow) sponge is active.", & units="nondim", default=0.1) - call get_param(param_file, mod, "DENSE_WATER_EAST_SPONGE_SALT", S_dense, & + call get_param(param_file, mdl, "DENSE_WATER_EAST_SPONGE_SALT", S_dense, & "Salt anomaly of the dense water being formed in the overflow region.", & units="1e-3", default=4.0) - call get_param(param_file, mod, "DENSE_WATER_MLD", mld, default=default_mld, do_not_log=.true.) - call get_param(param_file, mod, "DENSE_WATER_SILL_HEIGHT", sill_height, default=default_sill, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_MLD", mld, default=default_mld, do_not_log=.true.) + call get_param(param_file, mdl, "DENSE_WATER_SILL_HEIGHT", sill_height, default=default_sill, do_not_log=.true.) - call get_param(param_file, mod, "S_REF", S_ref, do_not_log=.true.) - call get_param(param_file, mod, "S_RANGE", S_range, do_not_log=.true.) - call get_param(param_file, mod, "T_REF", T_ref, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, do_not_log=.true.) + call get_param(param_file, mdl, "S_RANGE", S_range, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, do_not_log=.true.) ! no active sponges if (west_sponge_time_scale <= 0. .and. east_sponge_time_scale <= 0.) return diff --git a/src/user/external_gwave_initialization.F90 b/src/user/external_gwave_initialization.F90 index 6c4c407612..aa3b99161d 100644 --- a/src/user/external_gwave_initialization.F90 +++ b/src/user/external_gwave_initialization.F90 @@ -35,13 +35,14 @@ module external_gwave_initialization ! ----------------------------------------------------------------------------- !> This subroutine initializes layer thicknesses for the external_gwave experiment. -subroutine external_gwave_initialize_thickness(h, G, param_file) +subroutine external_gwave_initialize_thickness(h, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< The thickness that is being - !! initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. + real, dimension(SZI_(G),SZJ_(G),SZK_(G)), & + intent(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: e0(SZK_(G)) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -51,20 +52,30 @@ subroutine external_gwave_initialize_thickness(h, G, param_file) ! positive upward, in m. ! real :: ssh_anomaly_height ! Vertical height of ssh anomaly real :: ssh_anomaly_width ! Lateral width of anomaly - character(len=40) :: mod = "external_gwave_initialize_thickness" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "external_gwave_initialize_thickness" ! This subroutine's name. +! This include declares and sets the variable "version". +#include "version_variable.h" integer :: i, j, k, is, ie, js, je, nz real :: PI, Xnondim is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg(" external_gwave_initialization.F90, external_gwave_initialize_thickness: setting thickness", 5) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mod, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & + if (.not.just_read) & + call MOM_mesg(" external_gwave_initialization.F90, external_gwave_initialize_thickness: setting thickness", 5) + + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "SSH_ANOMALY_HEIGHT", ssh_anomaly_height, & "The vertical displacement of the SSH anomaly. ", units="m", & - fail_if_missing=.true.) - call get_param(param_file, mod, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & + fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "SSH_ANOMALY_WIDTH", ssh_anomaly_width, & "The lateral width of the SSH anomaly. ", units="coordinate", & - fail_if_missing=.true.) + fail_if_missing=.not.just_read, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. + PI = 4.0*atan(1.0) do j=G%jsc,G%jec ; do i=G%isc,G%iec Xnondim = (G%geoLonT(i,j)-G%west_lon-0.5*G%len_lon) / ssh_anomaly_width diff --git a/src/user/lock_exchange_initialization.F90 b/src/user/lock_exchange_initialization.F90 index 0ec3aedfc1..0e79eab962 100644 --- a/src/user/lock_exchange_initialization.F90 +++ b/src/user/lock_exchange_initialization.F90 @@ -37,37 +37,49 @@ module lock_exchange_initialization !> This subroutine initializes layer thicknesses for the lock_exchange experiment. ! ----------------------------------------------------------------------------- -subroutine lock_exchange_initialize_thickness(h, G, GV, param_file) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: h !< The thickness that is being initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the open file to - !! parse for model parameter values. +subroutine lock_exchange_initialize_thickness(h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. - real :: e0(SZK_(G)) ! The resting interface heights, in m, usually ! - ! negative because it is positive upward. ! - real :: e_pert(SZK_(G)) ! Interface height perturbations, positive ! - ! upward, in m. ! - real :: eta1D(SZK_(G)+1)! Interface height relative to the sea surface ! - ! positive upward, in m. ! + real :: e0(SZK_(GV)) ! The resting interface heights, in m, usually ! + ! negative because it is positive upward. ! + real :: e_pert(SZK_(GV)) ! Interface height perturbations, positive ! + ! upward, in m. ! + real :: eta1D(SZK_(GV)+1)! Interface height relative to the sea surface ! + ! positive upward, in m. ! real :: front_displacement ! Vertical displacement acrodd front real :: thermocline_thickness ! Thickness of stratified region - character(len=40) :: mod = "lock_exchange_initialize_thickness" ! This subroutine's name. + logical :: just_read ! If true, just read parameters but set nothing. +! This include declares and sets the variable "version". +#include "version_variable.h" + character(len=40) :: mdl = "lock_exchange_initialize_thickness" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg(" lock_exchange_initialization.F90, lock_exchange_initialize_thickness: setting thickness", 5) + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file, mod, "FRONT_DISPLACEMENT", front_displacement, & + if (.not.just_read) & + call MOM_mesg(" lock_exchange_initialization.F90, lock_exchange_initialize_thickness: setting thickness", 5) + + if (.not.just_read) call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "FRONT_DISPLACEMENT", front_displacement, & "The vertical displacement of interfaces across the front. \n"//& "A value larger in magnitude that MAX_DEPTH is truncated,", & - units="m", fail_if_missing=.true.) - call get_param(param_file, mod, "THERMOCLINE_THICKNESS", thermocline_thickness, & + units="m", fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl, "THERMOCLINE_THICKNESS", thermocline_thickness, & "The thickness of the thermocline in the lock exchange \n"//& "experiment. A value of zero creates a two layer system \n"//& "with vanished layers in between the two inflated layers.", & - default=0., units="m") + default=0., units="m", do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. do j=G%jsc,G%jec ; do i=G%isc,G%iec do k=2,nz diff --git a/src/user/seamount_initialization.F90 b/src/user/seamount_initialization.F90 index 647b168277..d6a45680b6 100644 --- a/src/user/seamount_initialization.F90 +++ b/src/user/seamount_initialization.F90 @@ -41,7 +41,7 @@ module seamount_initialization #include -character(len=40) :: mod = "seamount_initialization" ! This module's name. +character(len=40) :: mdl = "seamount_initialization" ! This module's name. ! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world @@ -68,14 +68,14 @@ subroutine seamount_initialize_topography ( D, G, param_file, max_depth ) integer :: i, j real :: x, y, delta, Lx, rLx, Ly, rLy - call get_param(param_file,mod,"SEAMOUNT_DELTA",delta, & + call get_param(param_file, mdl,"SEAMOUNT_DELTA",delta, & "Non-dimensional height of seamount.", & units="non-dim", default=0.5) - call get_param(param_file,mod,"SEAMOUNT_X_LENGTH_SCALE",Lx, & + call get_param(param_file, mdl,"SEAMOUNT_X_LENGTH_SCALE",Lx, & "Length scale of seamount in x-direction.\n"//& "Set to zero make topography uniform in the x-direction.", & units="Same as x,y", default=20.) - call get_param(param_file,mod,"SEAMOUNT_Y_LENGTH_SCALE",Ly, & + call get_param(param_file, mdl,"SEAMOUNT_Y_LENGTH_SCALE",Ly, & "Length scale of seamount in y-direction.\n"//& "Set to zero make topography uniform in the y-direction.", & units="Same as x,y", default=0.) @@ -97,14 +97,15 @@ end subroutine seamount_initialize_topography !> Initialization of thicknesses. !! This subroutine initializes the layer thicknesses to be uniform. -subroutine seamount_initialize_thickness ( h, G, GV, param_file ) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thicknesses being - !! initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. +subroutine seamount_initialize_thickness ( h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: e0(SZK_(G)+1) ! The resting interface heights, in m, usually ! ! negative because it is positive upward. ! @@ -115,14 +116,20 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file ) real :: delta_h real :: min_thickness, S_surf, S_range, S_ref, S_light, S_dense character(len=20) :: verticalCoordinate + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params - call get_param(param_file,mod,"MIN_THICKNESS",min_thickness,'Minimum thickness for layer',units='m',default=1.0e-3) - call get_param(param_file,mod,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) + if (.not.just_read) & + call MOM_mesg("MOM_initialization.F90, initialize_thickness_uniform: setting thickness") + + call get_param(param_file, mdl,"MIN_THICKNESS",min_thickness, & + 'Minimum thickness for layer',& + units='m', default=1.0e-3, do_not_log=just_read) + call get_param(param_file, mdl,"REGRIDDING_COORDINATE_MODE",verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) ! WARNING: this routine specifies the interface heights so that the last layer ! is vanished, even at maximum depth. In order to have a uniform @@ -138,11 +145,13 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file ) select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER, REGRIDDING_RHO ) ! Initial thicknesses for isopycnal coordinates - call get_param(param_file,mod,"INITIAL_SSS", S_surf, default=34., do_not_log=.true.) - call get_param(param_file,mod,"INITIAL_S_RANGE", S_range, default=2., do_not_log=.true.) - call get_param(param_file, mod, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl,"INITIAL_SSS", S_surf, default=34., do_not_log=.true.) + call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, default=2., do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. + do K=1,nz+1 ! Salinity of layer k is S_light + (k-1)/(nz-1) * (S_dense - S_light) ! Salinity of interface K is S_light + (K-3/2)/(nz-1) * (S_dense - S_light) @@ -169,6 +178,7 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file ) enddo ; enddo case ( REGRIDDING_ZSTAR ) ! Initial thicknesses for z coordinates + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie eta1D(nz+1) = -1.0*G%bathyT(i,j) do k=nz,1,-1 @@ -180,19 +190,22 @@ subroutine seamount_initialize_thickness ( h, G, GV, param_file ) h(i,j,k) = eta1D(k) - eta1D(k+1) endif enddo - enddo ; enddo + enddo ; enddo case ( REGRIDDING_SIGMA ) ! Initial thicknesses for sigma coordinates + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie delta_h = G%bathyT(i,j) / dfloat(nz) h(i,j,:) = delta_h end do ; end do + end select end subroutine seamount_initialize_thickness !> Initial values for temperature and salinity -subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, eqn_of_state) +subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file, & + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure type(verticalGrid_type), intent(in) :: GV !< Vertical grid structure real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC) @@ -200,38 +213,48 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(in) :: h !< Layer thickness (m or Pa) type(param_file_type), intent(in) :: param_file !< Parameter file structure type(EOS_type), pointer :: eqn_of_state !< Equation of state structure + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + ! Local variables integer :: i, j, k, is, ie, js, je, nz, k_light real :: xi0, xi1, dxi, r, S_surf, T_surf, S_range, T_range real :: T_ref, T_Light, T_Dense, S_ref, S_Light, S_Dense, a1, frac_dense, k_frac, res_rat + logical :: just_read ! If true, just read parameters but set nothing. character(len=20) :: verticalCoordinate, density_profile is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call get_param(param_file, mod, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & - default=DEFAULT_COORDINATE_MODE) - call get_param(param_file,mod,"INITIAL_DENSITY_PROFILE", density_profile, & + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl, "REGRIDDING_COORDINATE_MODE", verticalCoordinate, & + default=DEFAULT_COORDINATE_MODE, do_not_log=just_read) + call get_param(param_file, mdl,"INITIAL_DENSITY_PROFILE", density_profile, & 'Initial profile shape. Valid values are "linear", "parabolic"\n'// & - 'and "exponential".', default='linear') - call get_param(param_file,mod,"INITIAL_SSS", S_surf, & - 'Initial surface salinity', units='1e-3', default=34.) - call get_param(param_file,mod,"INITIAL_SST", T_surf, & - 'Initial surface temperature', units='C', default=0.) - call get_param(param_file,mod,"INITIAL_S_RANGE", S_range, & - 'Initial salinity range (bottom - surface)', units='1e-3', default=2.) - call get_param(param_file,mod,"INITIAL_T_RANGE", T_range, & - 'Initial temperature range (bottom - surface)', units='C', default=0.) + 'and "exponential".', default='linear', do_not_log=just_read) + call get_param(param_file, mdl,"INITIAL_SSS", S_surf, & + 'Initial surface salinity', units='1e-3', default=34., do_not_log=just_read) + call get_param(param_file, mdl,"INITIAL_SST", T_surf, & + 'Initial surface temperature', units='C', default=0., do_not_log=just_read) + call get_param(param_file, mdl,"INITIAL_S_RANGE", S_range, & + 'Initial salinity range (bottom - surface)', units='1e-3', & + default=2., do_not_log=just_read) + call get_param(param_file, mdl,"INITIAL_T_RANGE", T_range, & + 'Initial temperature range (bottom - surface)', units='C', & + default=0., do_not_log=just_read) select case ( coordinateMode(verticalCoordinate) ) case ( REGRIDDING_LAYER ) ! Initial thicknesses for layer isopycnal coordinates ! These parameters are used in MOM_fixed_initialization.F90 when CONFIG_COORD="ts_range" - call get_param(param_file, mod, "T_REF", T_ref, default=10.0, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_T_LIGHT", T_light, default=T_Ref, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_T_DENSE", T_dense, default=T_Ref, do_not_log=.true.) - call get_param(param_file, mod, "S_REF", S_ref, default=35.0, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) - call get_param(param_file, mod, "TS_RANGE_RESOLN_RATIO", res_rat, default=1.0, do_not_log=.true.) + call get_param(param_file, mdl, "T_REF", T_ref, default=10.0, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_T_LIGHT", T_light, default=T_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_T_DENSE", T_dense, default=T_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "S_REF", S_ref, default=35.0, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_LIGHT", S_light, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_S_DENSE", S_dense, default = S_Ref, do_not_log=.true.) + call get_param(param_file, mdl, "TS_RANGE_RESOLN_RATIO", res_rat, default=1.0, do_not_log=.true.) + if (just_read) return ! All run-time parameters have been read, so return. + ! Emulate the T,S used in the "ts_range" coordinate configuration code k_light = GV%nk_rho_varies + 1 do j=js,je ; do i=is,ie @@ -247,6 +270,7 @@ subroutine seamount_initialize_temperature_salinity ( T, S, h, G, GV, param_file enddo ; enddo enddo case ( REGRIDDING_SIGMA, REGRIDDING_ZSTAR, REGRIDDING_RHO ) ! All other coordinate use FV initialization + if (just_read) return ! All run-time parameters have been read, so return. do j=js,je ; do i=is,ie xi0 = 0.0 do k = 1,nz diff --git a/src/user/shelfwave_initialization.F90 b/src/user/shelfwave_initialization.F90 index 0cd78db7cc..aab5b5283f 100644 --- a/src/user/shelfwave_initialization.F90 +++ b/src/user/shelfwave_initialization.F90 @@ -33,7 +33,7 @@ module shelfwave_initialization #include -character(len=40) :: mod = "shelfwave_initialization" ! This module's name. +character(len=40) :: mdl = "shelfwave_initialization" ! This module's name. ! ----------------------------------------------------------------------------- ! The following routines are visible to the outside world @@ -78,18 +78,18 @@ function register_shelfwave_OBC(param_file, CS, OBC_Reg) ! Register the tracer for horizontal advection & diffusion. call register_OBC(casename, param_file, OBC_Reg) - call get_param(param_file,mod,"F_0",CS%f0, & + call get_param(param_file, mdl,"F_0",CS%f0, & do_not_log=.true.) - call get_param(param_file,mod,"LENLAT",len_lat, & + call get_param(param_file, mdl,"LENLAT",len_lat, & do_not_log=.true.) - call get_param(param_file,mod,"SHELFWAVE_X_WAVELENGTH",CS%Lx, & + call get_param(param_file, mdl,"SHELFWAVE_X_WAVELENGTH",CS%Lx, & "Length scale of shelfwave in x-direction.",& units="Same as x,y", default=100.) - call get_param(param_file,mod,"SHELFWAVE_Y_LENGTH_SCALE",CS%Ly, & + call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",CS%Ly, & "Length scale of exponential dropoff of topography\n"//& "in the y-direction.", & units="Same as x,y", default=50.) - call get_param(param_file,mod,"SHELFWAVE_Y_MODE",CS%jj, & + call get_param(param_file, mdl,"SHELFWAVE_Y_MODE",CS%jj, & "Cross-shore wave mode.", & units="nondim", default=1.) CS%alpha = 1. / CS%Ly @@ -123,9 +123,9 @@ subroutine shelfwave_initialize_topography ( D, G, param_file, max_depth ) integer :: i, j real :: y, rLy, Ly, H0 - call get_param(param_file,mod,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & + call get_param(param_file, mdl,"SHELFWAVE_Y_LENGTH_SCALE",Ly, & default=50., do_not_log=.true.) - call get_param(param_file,mod,"MINIMUM_DEPTH",H0, & + call get_param(param_file, mdl,"MINIMUM_DEPTH",H0, & default=10., do_not_log=.true.) rLy = 0. ; if (Ly>0.) rLy = 1. / Ly @@ -153,7 +153,7 @@ subroutine shelfwave_set_OBC_data(OBC, CS, G, h, Time) real :: my_amp, time_sec real :: cos_wt, cos_ky, sin_wt, sin_ky, omega, alpha real :: x, y, jj, kk, ll - character(len=40) :: mod = "shelfwave_set_OBC_data" ! This subroutine's name. + character(len=40) :: mdl = "shelfwave_set_OBC_data" ! This subroutine's name. integer :: i, j, k, is, ie, js, je, isd, ied, jsd, jed, n integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment diff --git a/src/user/sloshing_initialization.F90 b/src/user/sloshing_initialization.F90 index 7e00b24b18..51a5cc44c6 100644 --- a/src/user/sloshing_initialization.F90 +++ b/src/user/sloshing_initialization.F90 @@ -45,7 +45,7 @@ module sloshing_initialization public sloshing_initialize_thickness public sloshing_initialize_temperature_salinity -character(len=40) :: mod = "sloshing_initialization" ! This module's name. +character(len=40) :: mdl = "sloshing_initialization" ! This module's name. ! ----------------------------------------------------------------------------- ! This module contains the following routines @@ -82,14 +82,15 @@ end subroutine sloshing_initialize_topography !! same thickness but all interfaces (except bottom and sea surface) are !! displaced according to a half-period cosine, with maximum value on the !! left and minimum value on the right. This sets off a regular sloshing motion. -subroutine sloshing_initialize_thickness ( h, G, GV, param_file ) - type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. - type(verticalGrid_type), intent(in) :: GV !< The ocean's vertical grid structure. - real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(GV)) :: h !< The thicknesses being - !! initialized. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. +subroutine sloshing_initialize_thickness ( h, G, GV, param_file, just_read_params) + 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(out) :: h !< The thickness that is being initialized, in m. + type(param_file_type), intent(in) :: param_file !< A structure indicating the open file + !! to parse for model parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. real :: displ(SZK_(G)+1) real :: z_unif(SZK_(G)+1) @@ -101,12 +102,17 @@ subroutine sloshing_initialize_thickness ( h, G, GV, param_file ) real :: weight_z real :: x1, y1, x2, y2 real :: t + logical :: just_read ! If true, just read parameters but set nothing. integer :: n integer :: i, j, k, is, ie, js, je, nx, nz is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! This subroutine has no run-time parameters. + deltah = G%max_depth / nz ! Define thicknesses @@ -198,7 +204,7 @@ end subroutine sloshing_initialize_thickness !! Note that the linear distribution is set up with respect to the layer !! number, not the physical position). subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, param_file, & - eqn_of_state) + eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). @@ -207,6 +213,8 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, param_file, & !! open file to parse for model !! parameter values. type(EOS_type), pointer :: eqn_of_state !< Equation of state structure. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. integer :: i, j, k, is, ie, js, je, nz real :: delta_S, delta_T @@ -217,17 +225,27 @@ subroutine sloshing_initialize_temperature_salinity ( T, S, h, G, param_file, & integer :: kdelta real :: deltah real :: xi0, xi1 - character(len=40) :: mod = "initialize_temp_salt_linear" ! This subroutine's + logical :: just_read ! If true, just read parameters but set nothing. + character(len=40) :: mdl = "initialize_temp_salt_linear" ! This subroutine's ! name. is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec ; nz = G%ke - call get_param(param_file,mod,"S_REF",S_ref,'Reference value for salinity',units='1e-3',fail_if_missing=.true.) - call get_param(param_file,mod,"T_REF",T_ref,'Refernce value for temperature',units='C',fail_if_missing=.true.) + + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + call get_param(param_file, mdl,"S_REF",S_ref,'Reference value for salinity', & + units='1e-3', fail_if_missing=.not.just_read, do_not_log=just_read) + call get_param(param_file, mdl,"T_REF",T_ref,'Refernce value for temperature', & + units='C', fail_if_missing=.not.just_read, do_not_log=just_read) ! The default is to assume an increase by 2 for the salinity and a uniform ! temperature - call get_param(param_file,mod,"S_RANGE",S_range,'Initial salinity range.',units='1e-3',default=2.0) - call get_param(param_file,mod,"T_RANGE",T_range,'Initial temperature range',units='C',default=0.0) + call get_param(param_file, mdl,"S_RANGE",S_range,'Initial salinity range.', & + units='1e-3', default=2.0, do_not_log=just_read) + call get_param(param_file, mdl,"T_RANGE",T_range,'Initial temperature range', & + units='C', default=0.0, do_not_log=just_read) + + if (just_read) return ! All run-time parameters have been read, so return. ! Prescribe salinity !delta_S = S_range / ( G%ke - 1.0 ) diff --git a/src/user/soliton_initialization.F90 b/src/user/soliton_initialization.F90 index 3099342f2c..af1b69060e 100644 --- a/src/user/soliton_initialization.F90 +++ b/src/user/soliton_initialization.F90 @@ -22,7 +22,7 @@ module soliton_initialization #include ! Private (module-wise) parameters -character(len=40) :: mod = "soliton_initialization" !< This module's name. +character(len=40) :: mdl = "soliton_initialization" !< This module's name. public soliton_initialize_thickness public soliton_initialize_velocity diff --git a/src/user/supercritical_initialization.F90 b/src/user/supercritical_initialization.F90 index 22421d8b38..862b078750 100644 --- a/src/user/supercritical_initialization.F90 +++ b/src/user/supercritical_initialization.F90 @@ -30,7 +30,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. type(param_file_type), intent(in) :: param_file !< Parameter file structure ! Local variables - character(len=40) :: mod = "supercritical_set_OBC_data" ! This subroutine's name. + character(len=40) :: mdl = "supercritical_set_OBC_data" ! This subroutine's name. real :: zonal_flow integer :: i, j, k, l integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB @@ -39,7 +39,7 @@ subroutine supercritical_set_OBC_data(OBC, G, param_file) if (.not.associated(OBC)) call MOM_error(FATAL, 'supercritical_initialization.F90: '// & 'supercritical_set_OBC_data() was called but OBC type was not initialized!') - call get_param(param_file, mod, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & + call get_param(param_file, mdl, "SUPERCRITICAL_ZONAL_FLOW", zonal_flow, & "Constant zonal flow imposed at upstream open boundary.", & units="m/s", default=8.57) @@ -90,7 +90,7 @@ subroutine supercritical_initialize_topography(D, G, param_file, max_depth) type(param_file_type), intent(in) :: param_file !< Parameter file structure real, intent(in) :: max_depth !< Maximum depth of model in m ! Local variables - character(len=40) :: mod = "supercritical_initialize_topography" ! This subroutine's name. + character(len=40) :: mdl = "supercritical_initialize_topography" ! This subroutine's name. real :: min_depth ! The minimum and maximum depths in m. real :: PI ! 3.1415... real :: coast_offset, coast_angle @@ -98,13 +98,13 @@ subroutine supercritical_initialize_topography(D, G, param_file, max_depth) call MOM_mesg(" supercritical_initialization.F90, supercritical_initialize_topography: setting topography", 5) - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "MINIMUM_DEPTH", min_depth, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "MINIMUM_DEPTH", min_depth, & "The minimum depth of the ocean.", units="m", default=0.0) - call get_param(param_file, mod, "SUPERCRITICAL_COAST_OFFSET", coast_offset, & + call get_param(param_file, mdl, "SUPERCRITICAL_COAST_OFFSET", coast_offset, & "The distance along the southern boundary at which the coasts angles in.", & units="km", default=10.0) - call get_param(param_file, mod, "SUPERCRITICAL_COAST_ANGLE", coast_angle, & + call get_param(param_file, mdl, "SUPERCRITICAL_COAST_ANGLE", coast_angle, & "The angle of the southern bondary beyond X=SUPERCRITICAL_COAST_OFFSET.", & units="degrees", default=8.95) diff --git a/src/user/tidal_bay_initialization.F90 b/src/user/tidal_bay_initialization.F90 index 5252559e90..34134f54c9 100644 --- a/src/user/tidal_bay_initialization.F90 +++ b/src/user/tidal_bay_initialization.F90 @@ -89,7 +89,7 @@ subroutine tidal_bay_set_OBC_data(OBC, CS, G, h, Time) real :: my_flux, total_area real :: PI real, allocatable :: my_area(:,:) - character(len=40) :: mod = "tidal_bay_set_OBC_data" ! This subroutine's name. + character(len=40) :: mdl = "tidal_bay_set_OBC_data" ! This subroutine's name. integer :: i, j, k, itt, is, ie, js, je, isd, ied, jsd, jed, nz, n integer :: IsdB, IedB, JsdB, JedB type(OBC_segment_type), pointer :: segment diff --git a/src/user/user_change_diffusivity.F90 b/src/user/user_change_diffusivity.F90 index 90da372386..b863756b32 100644 --- a/src/user/user_change_diffusivity.F90 +++ b/src/user/user_change_diffusivity.F90 @@ -210,7 +210,7 @@ subroutine user_change_diff_init(Time, G, param_file, diag, CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "user_set_diffusivity" ! This module's name. + character(len=40) :: mdl = "user_set_diffusivity" ! This module's name. character(len=200) :: mesg integer :: i, j, is, ie, js, je @@ -226,26 +226,26 @@ subroutine user_change_diff_init(Time, G, param_file, diag, CS) CS%diag => diag ! Read all relevant parameters and write them to the model log. - call log_version(param_file, mod, version, "") - call get_param(param_file, mod, "USER_KD_ADD", CS%Kd_add, & + call log_version(param_file, mdl, version, "") + call get_param(param_file, mdl, "USER_KD_ADD", CS%Kd_add, & "A user-specified additional diffusivity over a range of \n"//& "latitude and density.", units="m2 s-1", default=0.0) if (CS%Kd_add /= 0.0) then - call get_param(param_file, mod, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & + call get_param(param_file, mdl, "USER_KD_ADD_LAT_RANGE", CS%lat_range(:), & "Four successive values that define a range of latitudes \n"//& "over which the user-specified extra diffusivity is \n"//& "applied. The four values specify the latitudes at \n"//& "which the extra diffusivity starts to increase from 0, \n"//& "hits its full value, starts to decrease again, and is \n"//& "back to 0.", units="degree", default=-1.0e9) - call get_param(param_file, mod, "USER_KD_ADD_RHO_RANGE", CS%rho_range(:), & + call get_param(param_file, mdl, "USER_KD_ADD_RHO_RANGE", CS%rho_range(:), & "Four successive values that define a range of potential \n"//& "densities over which the user-given extra diffusivity \n"//& "is applied. The four values specify the density at \n"//& "which the extra diffusivity starts to increase from 0, \n"//& "hits its full value, starts to decrease again, and is \n"//& "back to 0.", units="kg m-3", default=-1.0e9) - call get_param(param_file, mod, "USER_KD_ADD_USE_ABS_LAT", CS%use_abs_lat, & + call get_param(param_file, mdl, "USER_KD_ADD_USE_ABS_LAT", CS%use_abs_lat, & "If true, use the absolute value of latitude when \n"//& "checking whether a point fits into range of latitudes.", & default=.false.) diff --git a/src/user/user_initialization.F90 b/src/user/user_initialization.F90 index cca15cd23d..5f30808598 100644 --- a/src/user/user_initialization.F90 +++ b/src/user/user_initialization.F90 @@ -28,7 +28,8 @@ module user_initialization use MOM_io, only : open_file, read_data, read_axis_data, SINGLE_FILE use MOM_io, only : write_field, slasher use MOM_open_boundary, only : ocean_OBC_type, OBC_NONE, OBC_SIMPLE -use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N, OBC_DIRECTION_S +use MOM_open_boundary, only : OBC_DIRECTION_E, OBC_DIRECTION_W, OBC_DIRECTION_N +use MOM_open_boundary, only : OBC_DIRECTION_S use MOM_sponge, only : set_up_sponge_field, initialize_sponge, sponge_CS use MOM_tracer_registry, only : tracer_registry_type, add_tracer_OBC_values use MOM_variables, only : thermo_var_ptrs @@ -40,8 +41,7 @@ module user_initialization public USER_set_coord, USER_initialize_topography, USER_initialize_thickness public USER_initialize_velocity, USER_init_temperature_salinity -public USER_init_mixed_layer_density, USER_initialize_sponges -public USER_set_OBC_data, USER_set_rotation +public USER_initialize_sponges, USER_set_OBC_data, USER_set_rotation logical :: first_call = .true. @@ -89,7 +89,7 @@ subroutine USER_initialize_topography(D, G, param_file, max_depth) end subroutine USER_initialize_topography !> initialize thicknesses. -subroutine USER_initialize_thickness(h, G, param_file, T) +subroutine USER_initialize_thickness(h, G, param_file, T, just_read_params) type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure. real, intent(out), dimension(SZI_(G),SZJ_(G),SZK_(G)) :: h !< The thicknesses being !! initialized. @@ -97,10 +97,19 @@ subroutine USER_initialize_thickness(h, G, param_file, T) !! open file to parse for model !! parameter values. real, intent(in), dimension(SZI_(G),SZJ_(G), SZK_(G)) :: T !< Potential temperature. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + logical :: just_read ! If true, just read parameters but set nothing. + call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_thickness: " // & "Unmodified user routine called - you must edit the routine to use it") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! All run-time parameters have been read, so return. + h(:,:,1) = 0.0 if (first_call) call write_user_log(param_file) @@ -108,17 +117,26 @@ subroutine USER_initialize_thickness(h, G, param_file, T) end subroutine USER_initialize_thickness !> initialize velocities. -subroutine USER_initialize_velocity(u, v, G, param_file) +subroutine USER_initialize_velocity(u, v, G, param_file, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. real, dimension(SZIB_(G), SZJ_(G), SZK_(G)), intent(out) :: u !< i-component of velocity [m/s] real, dimension(SZI_(G), SZJB_(G), SZK_(G)), intent(out) :: v !< j-component of velocity [m/s] type(param_file_type), intent(in) :: param_file !< A structure indicating the !! open file to parse for model !! parameter values. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + logical :: just_read ! If true, just read parameters but set nothing. + call MOM_error(FATAL, & "USER_initialization.F90, USER_initialize_velocity: " // & "Unmodified user routine called - you must edit the routine to use it") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! All run-time parameters have been read, so return. + u(:,:,1) = 0.0 v(:,:,1) = 0.0 @@ -128,7 +146,7 @@ end subroutine USER_initialize_velocity !> This function puts the initial layer temperatures and salinities !! into T(:,:,:) and S(:,:,:). -subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state) +subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state, just_read_params) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: T !< Potential temperature (degC). real, dimension(SZI_(G),SZJ_(G), SZK_(G)), intent(out) :: S !< Salinity (ppt). @@ -137,11 +155,19 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state) !! parameter values. type(EOS_type), pointer :: eqn_of_state !< Integer that selects the !! equation of state. + logical, optional, intent(in) :: just_read_params !< If present and true, this call will + !! only read parameters without changing h. + + logical :: just_read ! If true, just read parameters but set nothing. call MOM_error(FATAL, & "USER_initialization.F90, USER_init_temperature_salinity: " // & "Unmodified user routine called - you must edit the routine to use it") + just_read = .false. ; if (present(just_read_params)) just_read = just_read_params + + if (just_read) return ! All run-time parameters have been read, so return. + T(:,:,1) = 0.0 S(:,:,1) = 0.0 @@ -149,32 +175,6 @@ subroutine USER_init_temperature_salinity(T, S, G, param_file, eqn_of_state) end subroutine USER_init_temperature_salinity -!> Set initial potential density of the mixed layer. -subroutine USER_init_mixed_layer_density(Rml, G, param_file, use_temperature, & - eqn_of_state, T, S, P_Ref) - type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), intent(out) :: Rml !< Mixed layer potential density. - type(param_file_type), intent(in) :: param_file !< A structure indicating the - !! open file to parse for model - !! parameter values. - logical, intent(in) :: use_temperature !< Whether to use potential - !! temperature. - type(EOS_type), optional, pointer :: eqn_of_state !< integer that selects the - !! equation of state. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), optional, intent(in) :: T !< Model potential temperature. - real, dimension(SZI_(G), SZJ_(G), SZK_(G)), optional, intent(in) :: S !< Model salinity. - real, optional, intent(in) :: P_Ref !< The coordinate-density - !! reference pressure in Pa. - call MOM_error(FATAL, & - "USER_initialization.F90, USER_init_mixed_layer_density: " // & - "Unmodified user routine called - you must edit the routine to use it") - - Rml(:,:,1) = 0.0 - - if (first_call) call write_user_log(param_file) - -end subroutine USER_init_mixed_layer_density - !> Set up the sponges. subroutine USER_initialize_sponges(G, use_temperature, tv, param_file, CSp, h) type(ocean_grid_type), intent(in) :: G !< Ocean grid structure. @@ -240,9 +240,9 @@ subroutine write_user_log(param_file) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "user_initialization" ! This module's name. + character(len=40) :: mdl = "user_initialization" ! This module's name. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) first_call = .false. end subroutine write_user_log diff --git a/src/user/user_revise_forcing.F90 b/src/user/user_revise_forcing.F90 index 055c7952dc..9b1fbeecd9 100644 --- a/src/user/user_revise_forcing.F90 +++ b/src/user/user_revise_forcing.F90 @@ -72,9 +72,9 @@ subroutine user_revise_forcing_init(param_file,CS) ! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mod = "user_revise_forcing" ! This module's name. + character(len=40) :: mdl = "user_revise_forcing" ! This module's name. - call log_version(param_file, mod, version) + call log_version(param_file, mdl, version) end subroutine user_revise_forcing_init