From 8da9eb922d9993c88fc4229d3cc975fd61f57e26 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 14 Jul 2019 15:16:14 -0600 Subject: [PATCH 1/6] changes to the interfaces to bring them more in line with dev/ncar latest --- config_src/mct_driver/MOM_ocean_model.F90 | 38 ++++----- config_src/mct_driver/MOM_surface_forcing.F90 | 78 ++++++++--------- config_src/mct_driver/ocn_comp_mct.F90 | 8 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 64 +++++++------- .../nuopc_driver/MOM_surface_forcing.F90 | 84 +++++++++---------- 5 files changed, 135 insertions(+), 137 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 64ef660dbf..8bb3346021 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -286,15 +286,15 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! Read all relevant parameters and write them to the model log. 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"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) 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"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then Ocean_sfc%stagger = AGRID @@ -308,17 +308,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i end if 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"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) 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"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) 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"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -339,8 +339,8 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, 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"//& + "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + "below berg are set to zero. Not applied for negative "//& " values.", units="non-dim", default=-1.0) endif @@ -350,9 +350,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! vertical integrals, since the related 3-d sums are not negligible in cost. call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "If HFREEZE > 0, melt potential will be computed. The actual depth "//& + "over which melt potential is computed will be min(HFREEZE, OBLD), "//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 3a82794723..47e676a3d3 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -1050,12 +1050,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) 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"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1063,46 +1063,46 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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, 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"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. This is "//& + "needed because the FMS coupling structure does not "//& + "limit the water that can be frozen out of the ocean and "//& + "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) 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"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) 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"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) 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"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.false.) 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"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) 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"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) ! smg: should get_param call should be removed when have A=B code reconciled. @@ -1111,8 +1111,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=CS%use_temperature,do_not_log=.true.) 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"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1120,14 +1120,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif 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"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then 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"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1141,19 +1141,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 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"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) 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, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) 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"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1171,8 +1171,8 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (restore_temp) then 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"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1199,11 +1199,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1238,14 +1238,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) 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, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1256,31 +1256,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! See whether sufficiently thick sea ice should be treated as rigid. 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"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then 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"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) 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"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5ce89fc9f7..5698335b6f 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -259,19 +259,19 @@ subroutine ocn_init_mct( EClock, cdata_o, x2o_o, o2x_o, NLFilename ) if (glb%sw_decomp) then call get_param(param_file, mdl, "SW_c1", glb%c1, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, direct shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c2", glb%c2, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "visible, diffuse shortwave.", units="nondim", default=0.285) call get_param(param_file, mdl, "SW_c3", glb%c3, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, direct shortwave.", units="nondim", default=0.215) call get_param(param_file, mdl, "SW_c4", glb%c4, & - "Coeff. used to convert net shortwave rad. into \n"//& + "Coeff. used to convert net shortwave rad. into "//& "near-IR, diffuse shortwave.", units="nondim", default=0.215) else glb%c1 = 0.0; glb%c2 = 0.0; glb%c3 = 0.0; glb%c4 = 0.0 diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index 9889887b04..abe583ffcc 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -286,41 +286,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call log_version(param_file, mdl, version, "") call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & - "If true, advance the state of MOM with a single step \n"//& - "including both dynamics and thermodynamics. If false, \n"//& + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& "the two phases are advanced with separate calls.", default=.true.) call get_param(param_file, mdl, "DT", OS%dt, & - "The (baroclinic) dynamics time step. The time-step that \n"//& - "is actually used will be an integer fraction of the \n"//& + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& "forcing time-step.", units="s", fail_if_missing=.true.) call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & - "The thermodynamic and tracer advection time step. \n"//& - "Ideally DT_THERM should be an integer multiple of DT \n"//& - "and less than the forcing or coupling time-step, unless \n"//& - "THERMO_SPANS_COUPLING is true, in which case DT_THERM \n"//& - "can be an integer multiple of the coupling timestep. By \n"//& + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& "default DT_THERM is set to DT.", units="s", default=OS%dt) call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & - "If true, the MOM will take thermodynamic and tracer \n"//& - "timesteps that can be longer than the coupling timestep. \n"//& - "The actual thermodynamic timestep that is used in this \n"//& - "case is the largest integer multiple of the coupling \n"//& + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& "timestep that is less than or equal to DT_THERM.", default=.false.) call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & - "If true, apply diabatic and thermodynamic processes, \n"//& - "including buoyancy forcing and mass gain or loss, \n"//& + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& "before stepping the dynamics forward.", default=.false.) 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"//& + "An integer whose bits encode which restart files are "//& + "written. Add 2 (bit 1) for a time-stamped file, and odd "//& + "(bit 0) for a non-time-stamped file. A restart file "//& + "will be saved at the end of the run segment for any "//& "non-negative value.", default=1) 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"//& + "A case-insensitive character string to indicate the "//& + "staggering of the surface velocity field that is "//& + "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE @@ -329,17 +329,17 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i trim(stagger)//" is invalid.") ; endif 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"//& + "If true, the coupled driver will add a globally-balanced "//& + "fresh-water flux that drives sea-surface salinity "//& "toward specified values.", default=.false.) 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"//& + "If true, the coupled driver will add a "//& + "heat flux that drives sea-surface temperature "//& "toward specified values.", default=.false.) 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"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "G_EARTH", G_Earth, & @@ -355,9 +355,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & - "If HFREEZE > 0, melt potential will be computed. The actual depth \n"//& - "over which melt potential is computed will be min(HFREEZE, OBLD), \n"//& - "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), \n"//& + "If HFREEZE > 0, melt potential will be computed. The actual depth "//& + "over which melt potential is computed will be min(HFREEZE, OBLD), "//& + "where OBLD is the boundary layer depth. If HFREEZE <= 0 (default), "//& "melt potential will not be computed.", units="m", default=-1.0, do_not_log=.true.) if (HFrz .gt. 0.0) then diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 78b3da0c1a..19353bcb7f 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -704,8 +704,6 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) wind_stagger = CS%wind_stagger #endif - if ((IOB%wind_stagger == AGRID) .or. (IOB%wind_stagger == BGRID_NE) .or. & - (IOB%wind_stagger == CGRID_NE)) wind_stagger = IOB%wind_stagger if (wind_stagger == BGRID_NE) then ! This is necessary to fill in the halo points. taux_at_q(:,:) = 0.0 ; tauy_at_q(:,:) = 0.0 @@ -1058,12 +1056,12 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, default=".") CS%inputdir = slasher(CS%inputdir) call get_param(param_file, mdl, "ENABLE_THERMODYNAMICS", CS%use_temperature, & - "If true, Temperature and salinity are used as state \n"//& + "If true, Temperature and salinity are used as state "//& "variables.", default=.true.) 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"//& + "The mean ocean density used with BOUSSINESQ true to "//& + "calculate accelerations and the mass for conservation "//& + "properties, or with BOUSSINSEQ false to convert some "//& "parameters from vertical units of m to kg m-2.", & units="kg m-3", default=1035.0) call get_param(param_file, mdl, "LATENT_HEAT_FUSION", CS%latent_heat_fusion, & @@ -1071,51 +1069,51 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, 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, 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"//& - "limit the water that can be frozen out of the ocean and \n"//& - "the ice-ocean heat fluxes are treated explicitly. No \n"//& + "The maximum surface pressure that can be exerted by the "//& + "atmosphere and floating sea-ice or ice shelves. This is "//& + "needed because the FMS coupling structure does not "//& + "limit the water that can be frozen out of the ocean and "//& + "the ice-ocean heat fluxes are treated explicitly. No "//& "limit is applied if a negative value is used.", units="Pa", & default=-1.0) 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"//& + "If true, adjusts the salinity restoring seen to zero "//& "whether restoring is via a salt flux or virtual precip.",& default=restore_salt) 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"//& + "If true, adjustments to salt restoring to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) 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"//& + "If true, adjusts the net fresh-water forcing seen "//& "by the ocean (including restoring) to zero.", default=.false.) if (CS%adjust_net_fresh_water_to_zero) & call get_param(param_file, mdl, "USE_NET_FW_ADJUSTMENT_SIGN_BUG", & CS%use_net_FW_adjustment_sign_bug, & - "If true, use the wrong sign for the adjustment to\n"//& + "If true, use the wrong sign for the adjustment to "//& "the net fresh-water.", default=.false.) 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"//& + "If true, adjustments to net fresh water to achieve zero net are "//& "made by scaling values without moving the zero contour.",& default=.false.) call get_param(param_file, mdl, "ICE_SALT_CONCENTRATION", & CS%ice_salt_concentration, & - "The assumed sea-ice salinity needed to reverse engineer the \n"//& + "The assumed sea-ice salinity needed to reverse engineer the "//& "melt flux (or ice-ocean fresh-water flux).", & units="kg/kg", default=0.005) 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"//& + "If true, return the sea surface height with the "//& + "correction for the atmospheric (and sea-ice) pressure "//& + "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) 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"//& + "A case-insensitive character string to indicate the "//& + "staggering of the input wind stress field. Valid "//& "values are 'A', 'B', or 'C'.", default="C") if (uppercase(stagger(1:1)) == 'A') then ; CS%wind_stagger = AGRID elseif (uppercase(stagger(1:1)) == 'B') then ; CS%wind_stagger = BGRID_NE @@ -1123,14 +1121,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, else ; call MOM_error(FATAL,"surface_forcing_init: WIND_STAGGER = "// & trim(stagger)//" is invalid.") ; endif 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"//& + "A factor multiplying the wind-stress given to the ocean by the "//& + "coupler. This is used for testing and should be =1.0 for any "//& "production runs.", default=1.0) if (restore_salt) then 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"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SALT_RESTORE_FILE", CS%salt_restore_file, & @@ -1144,19 +1142,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%Flux_const = CS%Flux_const / 86400.0 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"//& + "If true, the restoring of salinity is applied as a salt "//& "flux instead of as a freshwater flux.", default=.false.) 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, mdl, "MASK_SRESTORE_UNDER_ICE", & CS%mask_srestore_under_ice, & - "If true, disables SSS restoring under sea-ice based on a frazil\n"//& + "If true, disables SSS restoring under sea-ice based on a frazil "//& "criteria (SST<=Tf). Only used when RESTORE_SALINITY is True.", & default=.false.) 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"//& + "If true, disable SSS restoring in marginal seas. Only used when "//& "RESTORE_SALINITY is True.", default=.false.) call get_param(param_file, mdl, "BASIN_FILE", basin_file, & "A file in which to find the basin masks, in variable 'basin'.", & @@ -1171,14 +1169,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, enddo ; enddo endif call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & - "If true, read a file (salt_restore_mask) containing \n"//& + "If true, read a file (salt_restore_mask) containing "//& "a mask for SSS restoring.", default=.false.) endif if (restore_temp) then 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"//& + "The constant that relates the restoring surface fluxes "//& + "to the relative surface anomalies (akin to a piston "//& "velocity). Note the non-MKS units.", units="m day-1", & fail_if_missing=.true.) call get_param(param_file, mdl, "SST_RESTORE_FILE", CS%temp_restore_file, & @@ -1195,7 +1193,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & - "If true, read a file (temp_restore_mask) containing \n"//& + "If true, read a file (temp_restore_mask) containing "//& "a mask for SST restoring.", default=.false.) endif @@ -1208,11 +1206,11 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "The drag coefficient that applies to the tides.", & units="nondim", default=1.0e-4) call get_param(param_file, mdl, "READ_TIDEAMP", CS%read_TIDEAMP, & - "If true, read a file (given by TIDEAMP_FILE) containing \n"//& + "If true, read a file (given by TIDEAMP_FILE) containing "//& "the tidal amplitude with INT_TIDE_DISSIPATION.", default=.false.) if (CS%read_TIDEAMP) then call get_param(param_file, mdl, "TIDEAMP_FILE", TideAmp_file, & - "The path to the file containing the spatially varying \n"//& + "The path to the file containing the spatially varying "//& "tidal amplitudes with INT_TIDE_DISSIPATION.", & default="tideamp.nc") CS%utide=0.0 @@ -1247,14 +1245,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! constant. call get_param(param_file, mdl, "READ_GUST_2D", CS%read_gust_2d, & - "If true, use a 2-dimensional gustiness supplied from \n"//& + "If true, use a 2-dimensional gustiness supplied from "//& "an input file", default=.false.) 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, mdl, "GUST_2D_FILE", gust_file, & - "The file in which the wind gustiness is found in \n"//& + "The file in which the wind gustiness is found in "//& "variable gustiness.") call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) @@ -1264,31 +1262,31 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, ! See whether sufficiently thick sea ice should be treated as rigid. 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"//& + "If true, sea-ice is rigid enough to exert a "//& "nonhydrostatic pressure that resist vertical motion.", & default=.false.) if (CS%rigid_sea_ice) then 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"//& + "A typical density of sea ice, used with the kinematic "//& "viscosity, when USE_RIGID_SEA_ICE is true.", units="kg m-3", & default=900.0) call get_param(param_file, mdl, "SEA_ICE_VISCOSITY", CS%Kv_sea_ice, & - "The kinematic viscosity of sufficiently thick sea ice \n"//& + "The kinematic viscosity of sufficiently thick sea ice "//& "for use in calculating the rigidity of sea ice.", & units="m2 s-1", default=1.0e9) 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"//& + "The mass of sea-ice per unit area at which the sea-ice "//& "starts to exhibit rigidity", units="kg m-2", default=1000.0) endif call get_param(param_file, mdl, "ALLOW_ICEBERG_FLUX_DIAGNOSTICS", iceberg_flux_diags, & - "If true, makes available diagnostics of fluxes from icebergs\n"//& + "If true, makes available diagnostics of fluxes from icebergs "//& "as seen by MOM6.", default=.false.) call register_forcing_type_diags(Time, diag, US, CS%use_temperature, CS%handles, & use_berg_fluxes=iceberg_flux_diags) call get_param(param_file, mdl, "ALLOW_FLUX_ADJUSTMENTS", CS%allow_flux_adjustments, & - "If true, allows flux adjustments to specified via the \n"//& + "If true, allows flux adjustments to specified via the "//& "data_table using the component name 'OCN'.", default=.false.) if (CS%allow_flux_adjustments) then call data_override_init(Ocean_domain_in=G%Domain%mpp_domain) From 3995037e68cfeb2164c2ecff67ff291bf3165328 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Sun, 14 Jul 2019 15:24:22 -0600 Subject: [PATCH 2/6] more updates to have caps consistent with dev/ncar --- config_src/mct_driver/MOM_surface_forcing.F90 | 11 ----------- config_src/nuopc_driver/MOM_surface_forcing.F90 | 11 ----------- 2 files changed, 22 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 47e676a3d3..38041a8a65 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -505,17 +505,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & net_FW(i,j) = (((fluxes%lprec(i,j) + fluxes%fprec(i,j) + fluxes%seaice_melt(i,j)) + & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(fluxes%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + G%areaT(i,j) * & - (fluxes%salt_flux(i,j) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j)/G%areaT(i,j) enddo; enddo diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index 19353bcb7f..da7956feeb 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -544,17 +544,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & (fluxes%lrunoff(i,j) + fluxes%frunoff(i,j))) + & (fluxes%evap(i,j) + fluxes%vprec(i,j)) ) * G%areaT(i,j) - ! The following contribution appears to be calculating the volume flux of sea-ice - ! melt. This calculation is clearly WRONG if either sea-ice has variable - ! salinity or the sea-ice is completely fresh. - ! Bob thinks this is trying ensure the net fresh-water of the ocean + sea-ice system - ! is constant. - ! To do this correctly we will need a sea-ice melt field added to IOB. -AJA - ! GMM: as stated above, the following is wrong. CIME deals with volume/mass and - ! heat from sea ice/snow via seaice_melt and seaice_melt_heat, respectively. - if (associated(IOB%salt_flux) .and. (CS%ice_salt_concentration>0.0)) & - net_FW(i,j) = net_FW(i,j) + sign_for_net_FW_bug * G%areaT(i,j) * & - (IOB%salt_flux(i-i0,j-j0) / CS%ice_salt_concentration) net_FW2(i,j) = net_FW(i,j) / G%areaT(i,j) enddo ; enddo From 7c90fa004ddb6a95801e608b516e19a674998c3b Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 11:50:32 -0600 Subject: [PATCH 3/6] changes to get MOM_ocean_model.F90 closer to nuopc_driver --- config_src/mct_driver/MOM_ocean_model.F90 | 850 +++++++++++------- config_src/mct_driver/MOM_surface_forcing.F90 | 3 +- 2 files changed, 504 insertions(+), 349 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 8bb3346021..aa375809c2 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -1,21 +1,15 @@ +!> Top-level module for the MOM6 ocean model in coupled mode. module MOM_ocean_model ! This file is part of MOM6. See LICENSE.md for the license. -!----------------------------------------------------------------------- -! ! This is the top level module for the MOM6 ocean model. It contains routines ! for initialization, termination and update of ocean model state. This ! particular version wraps all of the calls for MOM6 in the calls that had ! been used for MOM4. ! -! Robert Hallberg -! -! -! ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -! use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization @@ -25,7 +19,7 @@ module MOM_ocean_model use MOM_diag_mediator, only : diag_ctrl, enable_averaging, disable_averaging use MOM_diag_mediator, only : diag_mediator_close_registration, diag_mediator_end use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners, fill_symmetric_edges +use MOM_domains, only : TO_ALL, Omit_Corners use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe use MOM_error_handler, only : callTree_enter, callTree_leave use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type @@ -35,15 +29,13 @@ module MOM_ocean_model use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing use MOM_forcing_type, only : set_derived_forcing_fields use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_forcing_type, only : allocate_mech_forcing use MOM_get_input, only : Get_MOM_Input, directories use MOM_grid, only : ocean_grid_type use MOM_io, only : close_file, file_exists, read_data, write_version_number use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS use MOM_restart, only : MOM_restart_CS, save_restart use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init -use MOM_surface_forcing, only : convert_IOB_to_fluxes +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS use MOM_surface_forcing, only : forcing_save_restart @@ -64,24 +56,15 @@ module MOM_ocean_model use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux use fms_mod, only : stdout use mpp_mod, only : mpp_chksum use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only : wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only : MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves ! MCT specfic routines -use ocn_cpl_indices, only : cpl_indices_type -use MOM_coms, only : reproducing_sum -use MOM_cpu_clock, only : cpu_clock_id, cpu_clock_begin, cpu_clock_end -use MOM_spatial_means, only : adjust_area_mean_to_zero -use MOM_diag_mediator, only : safe_alloc_ptr use MOM_domains, only : MOM_infra_end -use user_revise_forcing, only : user_alter_forcing -use data_override_mod, only : data_override - -! FMS modules -use time_interp_external_mod, only : time_interp_external #include @@ -92,35 +75,37 @@ module MOM_ocean_model implicit none ; public public ocean_model_init, ocean_model_end, update_ocean_model -public get_ocean_grid ! add by Jiande public ocean_model_save_restart, Ocean_stock_pe +public ice_ocean_boundary_type public ocean_model_init_sfc, ocean_model_flux_init public ocean_model_restart +public ice_ocn_bnd_type_chksum public ocean_public_type_chksum public ocean_model_data_get -public ice_ocn_bnd_type_chksum +public get_ocean_grid +!> This interface extracts a named scalar field or array from the ocean surface or public type interface ocean_model_data_get module procedure ocean_model_data1D_get module procedure ocean_model_data2D_get end interface + !> This type is used for communication with other components via the FMS coupler. !! The element names and types can be changed only with great deliberation, hence !! the persistnce of things like the cutsy element name "avg_kount". type, public :: ocean_public_type type(domain2d) :: Domain !< The domain for the surface fields. - logical :: is_ocean_pe !! .true. on processors that run the ocean model. + logical :: is_ocean_pe !< .true. on processors that run the ocean model. character(len=32) :: instance_name = '' !< A name that can be used to identify !! this instance of an ocean model, for example !! in ensembles when writing messages. integer, pointer, dimension(:) :: pelist => NULL() !< The list of ocean PEs. logical, pointer, dimension(:,:) :: maskmap =>NULL() !< A pointer to an array - !! indicating which logical processors are actually - !! used for the ocean code. The other logical - !! processors would be all land points and are not - !! assigned to actual processors. This need not be - !! assigned if all logical processors are used. + !! indicating which logical processors are actually used for + !! the ocean code. The other logical processors would be all + !! land points and are not assigned to actual processors. + !! This need not be assigned if all logical processors are used. integer :: stagger = -999 !< The staggering relative to the tracer points !! points of the two velocity components. Valid entries @@ -140,38 +125,38 @@ module MOM_ocean_model !! i.e. dzt(1) + eta_t + patm/rho0/grav (m) frazil =>NULL(), & !< Accumulated heating (in Joules/m^2) from frazil !! formation in the ocean. - melt_potential => NULL(), & !< Accumulated heat used to melt sea ice (in W/m^2) + melt_potential => NULL(), & !< Instantaneous heat used to melt sea ice (in J/m^2) area => NULL(), & !< cell area of the ocean surface, in m2. OBLD => NULL() !< Ocean boundary layer depth, in m. - type(coupler_2d_bc_type) :: fields !< A structure that may contain an - !! array of named tracer-related fields. - integer :: avg_kount !< Used for accumulating averages of this type. + type(coupler_2d_bc_type) :: fields !< A structure that may contain named + !! arrays of tracer-related surface fields. + integer :: avg_kount !< A count of contributions to running + !! sums, used externally by the FMS coupler + !! for accumulating averages of this type. integer, dimension(2) :: axes = 0 !< Axis numbers that are available - ! for I/O using this surface data. + !! for I/O using this surface data. end type ocean_public_type -!> Contains information about the ocean state, although it is not necessary that -!! this is implemented with all models. This type is NOT private, and can therefore CANNOT vary -!! between different ocean models. -type, public :: ocean_state_type - logical :: is_ocean_PE = .false. !< True if this is an ocean PE. - type(time_type) :: Time !< The ocean model's time and master clock. - integer :: Restart_control !< An integer that is bit-tested to determine whether - !! incremental restart files are saved and whether they - !! have a time stamped name. +1 (bit 0) for generic - !! files and +2 (bit 1) for time-stamped files. A - !! restart file is saved at the end of a run segment - !! unless Restart_control is negative. +!> The ocean_state_type contains all information about the state of the ocean, +!! with a format that is private so it can be readily changed without disrupting +!! other coupled components. +type, public :: ocean_state_type ; + ! This type is private, and can therefore vary between different ocean models. + logical :: is_ocean_PE = .false. !< True if this is an ocean PE. + type(time_type) :: Time !< The ocean model's time and master clock. + integer :: Restart_control !< An integer that is bit-tested to determine whether + !! incremental restart files are saved and whether they + !! have a time stamped name. +1 (bit 0) for generic + !! files and +2 (bit 1) for time-stamped files. A + !! restart file is saved at the end of a run segment + !! unless Restart_control is negative. + integer :: nstep = 0 !< The number of calls to update_ocean. logical :: use_ice_shelf !< If true, the ice shelf model is enabled. - logical :: icebergs_apply_rigid_boundary !< If true, the icebergs can change ocean bd condition. - real :: kv_iceberg !< The viscosity of the icebergs in m2/s (for ice rigidity) - real :: berg_area_threshold !< Fraction of grid cell which iceberg must occupy - !! so that fluxes below are set to zero. (0.5 is a - !! good value to use. Not applied for negative values. - real :: latent_heat_fusion !< Latent heat of fusion - real :: density_iceberg !< A typical density of icebergs in kg/m3 (for ice rigidity) - type(ice_shelf_CS), pointer :: Ice_shelf_CSp => NULL() !< ice shelf structure. + logical :: use_waves !< If true use wave coupling. + + logical :: icebergs_alter_ocean !< If true, the icebergs can change ocean the + !! ocean dynamics and forcing fluxes. logical :: restore_salinity !< If true, the coupled MOM driver adds a term to !! restore salinity to a specified value. logical :: restore_temp !< If true, the coupled MOM driver adds a term to @@ -186,23 +171,49 @@ module MOM_ocean_model !! fields necessary to integrate only the tracer advection !! and diffusion equation read in from files stored from !! a previous integration of the prognostic model. - type(directories) :: dirs !< A structure containing several relevant directory paths. - type(mech_forcing) :: forces!< A structure with the driving mechanical surface forces - type(forcing) :: fluxes !< A structure containing pointers to - !! the ocean forcing fields. - type(forcing) :: flux_tmp !< A secondary structure containing pointers to the + + logical :: single_step_call !< If true, advance the state of MOM with a single + !! step including both dynamics and thermodynamics. + !! If false, the two phases are advanced with + !! separate calls. The default is true. + ! The following 3 variables are only used here if single_step_call is false. + real :: dt !< (baroclinic) dynamics time step (seconds) + real :: dt_therm !< thermodynamics time step (seconds) + logical :: thermo_spans_coupling !< If true, thermodynamic and tracer time + !! steps can span multiple coupled time steps. + logical :: diabatic_first !< If true, apply diabatic and thermodynamic + !! processes before time stepping the dynamics. + + type(directories) :: dirs !< A structure containing several relevant directory paths. + type(mech_forcing) :: forces !< A structure with the driving mechanical surface forces + type(forcing) :: fluxes !< A structure containing pointers to + !! the thermodynamic ocean forcing fields. + type(forcing) :: flux_tmp !< A secondary structure containing pointers to the !! ocean forcing fields for when multiple coupled !! timesteps are taken per thermodynamic step. - type(surface) :: sfc_state !< A structure containing pointers to + type(surface) :: sfc_state !< A structure containing pointers to !! the ocean surface state fields. - type(ocean_grid_type), pointer :: grid => NULL() !< A pointer to a grid structure - !! containing metrics and related information. - type(verticalGrid_type), pointer :: GV => NULL() !< A pointer to a vertical grid - !! structure containing metrics and related information. + type(ocean_grid_type), pointer :: & + grid => NULL() !< A pointer to a grid structure containing metrics + !! and related information. + type(verticalGrid_type), pointer :: & + GV => NULL() !< A pointer to a structure containing information + !! about the vertical grid. type(unit_scale_type), pointer :: US => NULL() !< A pointer to a structure containing !! dimensional unit scaling factors. - type(MOM_control_struct), pointer :: MOM_CSp => NULL() - type(surface_forcing_CS), pointer :: forcing_CSp => NULL() + type(MOM_control_struct), pointer :: & + MOM_CSp => NULL() !< A pointer to the MOM control structure + type(ice_shelf_CS), pointer :: & + Ice_shelf_CSp => NULL() !< A pointer to the control structure for the + !! ice shelf model that couples with MOM6. This + !! is null if there is no ice shelf. + type(marine_ice_CS), pointer :: & + marine_ice_CSp => NULL() !< A pointer to the control structure for the + !! marine ice effects module. + type(wave_parameters_cs), pointer :: & + Waves !< A structure containing pointers to the surface wave fields + type(surface_forcing_CS), pointer :: & + forcing_CSp => NULL() !< A pointer to the MOM forcing control structure type(MOM_restart_CS), pointer :: & restart_CSp => NULL() !< A pointer set to the restart control structure !! that will be used for MOM restart files. @@ -210,26 +221,19 @@ module MOM_ocean_model diag => NULL() !< A pointer to the diagnostic regulatory structure end type ocean_state_type -integer :: id_clock_forcing - -!======================================================================= contains -!======================================================================= - -!======================================================================= -! -! -! -! Initialize the ocean model. -! -!> Initializes the ocean model, including registering fields +!> ocean_model_init initializes the ocean model, including registering fields !! for restarts and reading restart files if appropriate. +!! +!! This subroutine initializes both the ocean state and the ocean surface type. +!! Because of the way that indicies and domains are handled, Ocean_sfc must have +!! been used in a previous call to initialize_ocean_type. subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, input_restart_file) type(ocean_public_type), target, & - intent(inout) :: Ocean_sfc !< A structure containing various - !! publicly visible ocean surface properties after initialization, - !! the data in this type is intent(out). + intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, + !! the data in this type is intent out. type(ocean_state_type), pointer :: OS !< A structure whose internal !! contents are private to ocean_model_mod that may be used to !! contain all information about the ocean's interior state. @@ -242,28 +246,24 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i !! tracer fluxes, and can be used to spawn related !! internal variables in the ice model. character(len=*), optional, intent(in) :: input_restart_file !< If present, name of restart file to read - -! This subroutine initializes both the ocean state and the ocean surface type. -! Because of the way that indicies and domains are handled, Ocean_sfc must have -! been used in a previous call to initialize_ocean_type. - - real :: Rho0 !< The Boussinesq ocean density [kg m-3]. - real :: G_Earth !< The gravitational acceleration [m s-2]. - !! This include declares and sets the variable "version". - real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. - !! The actual depth over which melt potential is computed will - !! min(HFrz, OBLD), where OBLD is the boundary layer depth. - !! If HFrz <= 0 (default), melt potential will not be computed. + ! Local variables + real :: Rho0 ! The Boussinesq ocean density, in kg m-3. + real :: G_Earth ! The gravitational acceleration in m s-2. + real :: HFrz !< If HFrz > 0 (m), melt potential will be computed. + !! The actual depth over which melt potential is computed will + !! min(HFrz, OBLD), where OBLD is the boundary layer depth. + !! If HFrz <= 0 (default), melt potential will not be computed. logical :: use_melt_pot!< If true, allocate melt_potential array +! This include declares and sets the variable "version". #include "version_variable.h" - character(len=40) :: mdl = "ocean_model_init" !< This module's name. + character(len=40) :: mdl = "ocean_model_init" ! This module's name. character(len=48) :: stagger - logical :: use_temperature integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters + logical :: use_temperature - call callTree_enter("ocean_model_init(), ocn_comp_mct.F90") + call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then call MOM_error(WARNING, "ocean_model_init called with an associated "// & "ocean_state_type structure. Model is already initialized.") @@ -277,14 +277,41 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i OS%Time = Time_in call initialize_MOM(OS%Time, Time_init, param_file, OS%dirs, OS%MOM_CSp, & OS%restart_CSp, Time_in, offline_tracer_mode=OS%offline_tracer_mode, & - input_restart_file=input_restart_file, diag_ptr=OS%diag, & - count_calls=.true.) - call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%fluxes%C_p, & + input_restart_file=input_restart_file, & + diag_ptr=OS%diag, count_calls=.true.) + call get_MOM_state_elements(OS%MOM_CSp, G=OS%grid, GV=OS%GV, US=OS%US, C_p=OS%C_p, & use_temp=use_temperature) - OS%C_p = OS%fluxes%C_p + OS%fluxes%C_p = OS%C_p ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") + + call get_param(param_file, mdl, "SINGLE_STEPPING_CALL", OS%single_step_call, & + "If true, advance the state of MOM with a single step "//& + "including both dynamics and thermodynamics. If false, "//& + "the two phases are advanced with separate calls.", default=.true.) + call get_param(param_file, mdl, "DT", OS%dt, & + "The (baroclinic) dynamics time step. The time-step that "//& + "is actually used will be an integer fraction of the "//& + "forcing time-step.", units="s", fail_if_missing=.true.) + call get_param(param_file, mdl, "DT_THERM", OS%dt_therm, & + "The thermodynamic and tracer advection time step. "//& + "Ideally DT_THERM should be an integer multiple of DT "//& + "and less than the forcing or coupling time-step, unless "//& + "THERMO_SPANS_COUPLING is true, in which case DT_THERM "//& + "can be an integer multiple of the coupling timestep. By "//& + "default DT_THERM is set to DT.", units="s", default=OS%dt) + call get_param(param_file, "MOM", "THERMO_SPANS_COUPLING", OS%thermo_spans_coupling, & + "If true, the MOM will take thermodynamic and tracer "//& + "timesteps that can be longer than the coupling timestep. "//& + "The actual thermodynamic timestep that is used in this "//& + "case is the largest integer multiple of the coupling "//& + "timestep that is less than or equal to DT_THERM.", default=.false.) + call get_param(param_file, mdl, "DIABATIC_FIRST", OS%diabatic_first, & + "If true, apply diabatic and thermodynamic processes, "//& + "including buoyancy forcing and mass gain or loss, "//& + "before stepping the dynamics forward.", default=.false.) + call get_param(param_file, mdl, "RESTART_CONTROL", OS%Restart_control, & "An integer whose bits encode which restart files are "//& "written. Add 2 (bit 1) for a time-stamped file, and odd "//& @@ -296,16 +323,11 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i "staggering of the surface velocity field that is "//& "returned to the coupler. Valid values include "//& "'A', 'B', or 'C'.", default="C") - if (uppercase(stagger(1:1)) == 'A') then - Ocean_sfc%stagger = AGRID - elseif (uppercase(stagger(1:1)) == 'B') then - Ocean_sfc%stagger = BGRID_NE - elseif (uppercase(stagger(1:1)) == 'C') then - Ocean_sfc%stagger = CGRID_NE - else - call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & - trim(stagger)//" is invalid.") - end if + if (uppercase(stagger(1:1)) == 'A') then ; Ocean_sfc%stagger = AGRID + elseif (uppercase(stagger(1:1)) == 'B') then ; Ocean_sfc%stagger = BGRID_NE + elseif (uppercase(stagger(1:1)) == 'C') then ; Ocean_sfc%stagger = CGRID_NE + else ; call MOM_error(FATAL,"ocean_model_init: OCEAN_SURFACE_STAGGER = "// & + trim(stagger)//" is invalid.") ; endif call get_param(param_file, mdl, "RESTORE_SALINITY",OS%restore_salinity, & "If true, the coupled driver will add a globally-balanced "//& @@ -328,26 +350,23 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i 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, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_apply_rigid_boundary, & + call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "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, mdl, "KV_ICEBERG", OS%kv_iceberg, & - "The viscosity of the icebergs", units="m2 s-1",default=1.0e10) - 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, mdl, "LATENT_HEAT_FUSION", OS%latent_heat_fusion, & - "The latent heat of fusion.", units="J/kg", default=hlf) - call get_param(param_file, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - "Fraction of grid cell which iceberg must occupy, so that fluxes "//& - "below berg are set to zero. Not applied for negative "//& - " values.", units="non-dim", default=-1.0) - endif + ! MV: question for Gustavo - what to do with the following? - OS%press_to_z = 1.0/(Rho0*G_Earth) + ! 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, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & + ! "A typical density of icebergs.", units="kg m-3", default=917.0) + ! 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, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & + ! "Fraction of grid cell which iceberg must occupy, so that fluxes "//& + ! "below berg are set to zero. Not applied for negative "//& + ! " values.", units="non-dim", default=-1.0) - ! Consider using a run-time flag to determine whether to do the diagnostic - ! vertical integrals, since the related 3-d sums are not negligible in cost. + OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & "If HFREEZE > 0, melt potential will be computed. The actual depth "//& @@ -361,8 +380,10 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i use_melt_pot=.false. endif - call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, do_integrals=.true., & - gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) + ! Consider using a run-time flag to determine whether to do the diagnostic + ! vertical integrals, since the related 3-d sums are not negligible in cost. + call allocate_surface_state(OS%sfc_state, OS%grid, use_temperature, & + do_integrals=.true., gas_fields_ocn=gas_fields_ocn, use_meltpot=use_melt_pot) call surface_forcing_init(Time_in, OS%grid, OS%US, param_file, OS%diag, & OS%forcing_CSp, OS%restore_salinity, OS%restore_temp) @@ -371,12 +392,28 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call initialize_ice_shelf(param_file, OS%grid, OS%Time, OS%ice_shelf_CSp, & OS%diag, OS%forces, OS%fluxes) endif - if (OS%icebergs_apply_rigid_boundary) then - !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) + + if (OS%icebergs_alter_ocean) then + call marine_ice_init(OS%Time, OS%grid, param_file, OS%diag, OS%marine_ice_CSp) + if (.not. OS%use_ice_shelf) & + call allocate_forcing_type(OS%grid, OS%fluxes, shelf=.true.) + endif + + call get_param(param_file, mdl, "USE_WAVES", OS%Use_Waves, & + "If true, enables surface wave modules.", default=.false.) + if (OS%use_waves) then + call MOM_wave_interface_init(OS%Time, OS%grid, OS%GV, OS%US, param_file, OS%Waves, OS%diag) + else + call MOM_wave_interface_init_lite(param_file) endif + ! MV - what to do with the following? + ! if (OS%icebergs_apply_rigid_boundary) then + ! !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) + ! !This assumes that the iceshelf and ocean are on the same grid. I hope this is true + ! if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) + ! endif + if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & OS%diag, maskmap=OS%grid%Domain%maskmap, & @@ -389,6 +426,9 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i ! This call can only occur here if the coupler_bc_type variables have been ! initialized already using the information from gas_fields_ocn. if (present(gas_fields_ocn)) then + call coupler_type_set_diags(Ocean_sfc%fields, "ocean_sfc", & + Ocean_sfc%axes(1:2), Time_in) + call extract_surface_state(OS%MOM_CSp, OS%sfc_state) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) @@ -397,60 +437,69 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call close_param_file(param_file) call diag_mediator_close_registration(OS%diag) - call callTree_leave("ocean_model_init(") + if (is_root_pe()) & + write(*,'(/12x,a/)') '======== COMPLETED MOM INITIALIZATION ========' + call callTree_leave("ocean_model_init(") end subroutine ocean_model_init -! NAME="ocean_model_init" -!======================================================================= -! -! -! -! Update in time the ocean model fields. This code wraps the call to step_MOM -! with MOM4's call. -! -! - -!> Updates the ocean model fields. This code wraps the call to step_MOM with MOM6's call. -!! It uses the forcing to advance the ocean model's state from the -!! input value of Ocean_state (which must be for time time_start_update) for a time interval -!! of Ocean_coupling_time_step, returning the publicly visible ocean surface properties in -!! Ocean_sfc and storing the new ocean properties in Ocean_state. +!> update_ocean_model uses the forcing in Ice_ocean_boundary to advance the +!! ocean model's state from the input value of Ocean_state (which must be for +!! time time_start_update) for a time interval of Ocean_coupling_time_step, +!! returning the publicly visible ocean surface properties in Ocean_sfc and +!! storing the new ocean properties in Ocean_state. subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & - time_start_update, Ocean_coupling_time_step) - + time_start_update, Ocean_coupling_time_step, & + update_dyn, update_thermo, Ocn_fluxes_used) type(ice_ocean_boundary_type), & intent(in) :: Ice_ocean_boundary !< A structure containing the !! various forcing fields coming from the ice. - type(ocean_state_type), & pointer :: OS !< A pointer to a private structure containing !! the internal ocean state. - type(ocean_public_type), & intent(inout) :: Ocean_sfc !< A structure containing all the !! publicly visible ocean surface fields after !! a coupling time step. The data in this type is !! intent out. - type(time_type), intent(in) :: time_start_update !< The time at the beginning of the update step. type(time_type), intent(in) :: Ocean_coupling_time_step !< The amount of time over !! which to advance the ocean. - - ! local variables - type(time_type) :: Master_time !< This allows step_MOM to temporarily change - !! the time that is seen by internal modules. - type(time_type) :: Time1 !< The value of the ocean model's time at the - !! start of a call to step_MOM. - integer :: index_bnds(4) ! The computational domain index bounds in the ice-ocn boundary type - real :: weight !< Flux accumulation weight - real :: time_step !< The time step of a call to step_MOM in seconds. + logical, optional, intent(in) :: update_dyn !< If present and false, do not do updates + !! due to the ocean dynamics. + logical, optional, intent(in) :: update_thermo !< If present and false, do not do updates + !! due to the ocean thermodynamics or remapping. + logical, optional, intent(in) :: Ocn_fluxes_used !< If present, this indicates whether the + !! cumulative thermodynamic fluxes from the ocean, + !! like frazil, have been used and should be reset. + ! Local variables + type(time_type) :: Master_time ! This allows step_MOM to temporarily change + ! the time that is seen by internal modules. + type(time_type) :: Time1 ! The value of the ocean model's time at the + ! start of a call to step_MOM. + integer :: index_bnds(4) ! The computational domain index bounds in the + ! ice-ocean boundary type. + real :: weight ! Flux accumulation weight + real :: dt_coupling ! The coupling time step in seconds. + integer :: nts ! The number of baroclinic dynamics time steps + ! within dt_coupling. + real :: dt_therm ! A limited and quantized version of OS%dt_therm (sec) + real :: dt_dyn ! The dynamics time step in sec. + real :: dtdia ! The diabatic time step in sec. + real :: t_elapsed_seg ! The elapsed time in this update segment, in s. + integer :: n, n_max, n_last_thermo + type(time_type) :: Time2 ! A temporary time. + logical :: thermo_does_span_coupling ! If true, thermodynamic forcing spans + ! multiple dynamic timesteps. + logical :: do_dyn ! If true, step the ocean dynamics and transport. + logical :: do_thermo ! If true, step the ocean thermodynamics. + logical :: step_thermo ! If true, take a thermodynamic step. integer :: secs, days integer :: is, ie, js, je call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) - time_step = 86400.0*real(days) + real(secs) + dt_coupling = 86400.0*real(days) + real(secs) if (time_start_update /= OS%Time) then call MOM_error(WARNING, "update_ocean_model: internal clock does not "//& @@ -464,6 +513,9 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & return endif + do_dyn = .true. ; if (present(update_dyn)) do_dyn = update_dyn + do_thermo = .true. ; if (present(update_thermo)) do_thermo = update_thermo + ! This is benign but not necessary if ocean_model_init_sfc was called or if ! OS%sfc_state%tr_fields was spawned in ocean_model_init. Consider removing it. is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -481,62 +533,84 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & if (OS%fluxes%fluxes_used) then ! GMM, is enable_averaging needed now? - call enable_averaging(time_step, OS%Time + Ocean_coupling_time_step, OS%diag) - - ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp) - - ! Fields that exist in both the forcing and mech_forcing types must be copied. - call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) - -#ifdef _USE_GENERIC_TRACER - call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes -#endif + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & + OS%restore_salinity, OS%restore_temp) + ! Add ice shelf fluxes if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%fluxes, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + endif + if (OS%icebergs_alter_ocean) then + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%fluxes, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! GMM, check ocean_model_MOM.F90 to enable the following option !if (OS%icebergs_apply_rigid_boundary) then ! This assumes that the iceshelf and ocean are on the same grid. I hope this is true. ! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold) + ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) !endif + ! Fields that exist in both the forcing and mech_forcing types must be copied. + call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) + +#ifdef _USE_GENERIC_TRACER + call enable_averaging(dt_coupling, OS%Time + Ocean_coupling_time_step, OS%diag) !Is this needed? + call MOM_generic_tracer_fluxes_accumulate(OS%fluxes, weight) !here weight=1, just saving the current fluxes +#endif + ! Indicate that there are new unused fluxes. OS%fluxes%fluxes_used = .false. - OS%fluxes%dt_buoy_accum = time_step + OS%fluxes%dt_buoy_accum = dt_coupling else OS%flux_tmp%C_p = OS%fluxes%C_p - ! Import fluxes from coupler to ocean. Also, perform do SST and SSS restoring, if needed. - call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, OS%Time, OS%grid, OS%US, OS%forcing_CSp, & - OS%sfc_state, OS%restore_salinity, OS%restore_temp) + if (do_thermo) & + call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%flux_tmp, index_bnds, OS%Time, & + OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, OS%restore_salinity,OS%restore_temp) if (OS%use_ice_shelf) then - call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, time_step, OS%Ice_shelf_CSp) - call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + if (do_thermo) & + call shelf_calc_flux(OS%sfc_state, OS%flux_tmp, OS%Time, dt_coupling, OS%Ice_shelf_CSp) + if (do_dyn) & + call add_shelf_forces(OS%grid, OS%Ice_shelf_CSp, OS%forces) + endif + if (OS%icebergs_alter_ocean) then + if (do_dyn) & + call iceberg_forces(OS%grid, OS%forces, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) + if (do_thermo) & + call iceberg_fluxes(OS%grid, OS%flux_tmp, OS%use_ice_shelf, & + OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif ! GMM, check ocean_model_MOM.F90 to enable the following option !if (OS%icebergs_apply_rigid_boundary) then !This assumes that the iceshelf and ocean are on the same grid. I hope this is true ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, time_step, OS%berg_area_threshold) + ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) !endif - ! Accumulate the forcing over time steps - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, time_step, OS%grid, weight) + call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types - ! are time-averages must be copied back to the forces type. + ! (e.g., ustar) are time-averages must be copied back to the forces type. call copy_back_forcing_fields(OS%fluxes, OS%forces, OS%grid) + #ifdef _USE_GENERIC_TRACER call MOM_generic_tracer_fluxes_accumulate(OS%flux_tmp, weight) !weight of the current flux in the running average #endif @@ -545,6 +619,10 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call set_derived_forcing_fields(OS%forces, OS%fluxes, OS%grid, OS%US, OS%GV%Rho0) call set_net_mass_forcing(OS%fluxes, OS%forces, OS%grid) + if (OS%use_waves) then + call Update_Surface_Waves(OS%grid, OS%GV, OS%US, OS%time, ocean_coupling_time_step, OS%waves) + endif + if (OS%nstep==0) then call finish_MOM_initialization(OS%Time, OS%dirs, OS%MOM_CSp, OS%restart_CSp) endif @@ -553,16 +631,81 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & Master_time = OS%Time ; Time1 = OS%Time if(OS%offline_tracer_mode) then - call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) + call step_offline(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp) + + elseif ((.not.do_thermo) .or. (.not.do_dyn)) then + ! The call sequence is being orchestrated from outside of update_ocean_model. + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=do_thermo, do_thermodynamics=do_dyn, & + reset_therm=Ocn_fluxes_used) + + elseif (OS%single_step_call) then + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, dt_coupling, OS%MOM_CSp, Waves=OS%Waves) + else - call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time1, time_step, OS%MOM_CSp) + n_max = 1 ; if (dt_coupling > OS%dt) n_max = ceiling(dt_coupling/OS%dt - 0.001) + dt_dyn = dt_coupling / real(n_max) + thermo_does_span_coupling = (OS%thermo_spans_coupling .and. & + (OS%dt_therm > 1.5*dt_coupling)) + + if (thermo_does_span_coupling) then + dt_therm = dt_coupling * floor(OS%dt_therm / dt_coupling + 0.001) + nts = floor(dt_therm/dt_dyn + 0.001) + else + nts = MAX(1,MIN(n_max,floor(OS%dt_therm/dt_dyn + 0.001))) + n_last_thermo = 0 + endif + + Time2 = Time1 ; t_elapsed_seg = 0.0 + do n=1,n_max + if (OS%diabatic_first) then + if (thermo_does_span_coupling) call MOM_error(FATAL, & + "MOM is not yet set up to have restarts that work with "//& + "THERMO_SPANS_COUPLING and DIABATIC_FIRST.") + if (modulo(n-1,nts)==0) then + dtdia = dt_dyn*min(nts,n_max-(n-1)) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + endif + + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + else + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dt_dyn, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.true., do_thermodynamics=.false., & + start_cycle=(n==1), end_cycle=.false., cycle_length=dt_coupling) + + step_thermo = .false. + if (thermo_does_span_coupling) then + dtdia = dt_therm + step_thermo = MOM_state_is_synchronized(OS%MOM_CSp, adv_dyn=.true.) + elseif ((modulo(n,nts)==0) .or. (n==n_max)) then + dtdia = dt_dyn*(n - n_last_thermo) + n_last_thermo = n + step_thermo = .true. + endif + + if (step_thermo) then + ! Back up Time2 to the start of the thermodynamic segment. + Time2 = Time2 - set_time(int(floor((dtdia - dt_dyn) + 0.5))) + call step_MOM(OS%forces, OS%fluxes, OS%sfc_state, Time2, dtdia, OS%MOM_CSp, & + Waves=OS%Waves, do_dynamics=.false., do_thermodynamics=.true., & + start_cycle=.false., end_cycle=(n==n_max), cycle_length=dt_coupling) + endif + endif + + t_elapsed_seg = t_elapsed_seg + dt_dyn + Time2 = Time1 + set_time(int(floor(t_elapsed_seg + 0.5))) + enddo endif OS%Time = Master_time + Ocean_coupling_time_step OS%nstep = OS%nstep + 1 - call enable_averaging(time_step, OS%Time, OS%diag) - call mech_forcing_diags(OS%forces, time_step, OS%grid, OS%diag, OS%forcing_CSp%handles) + call enable_averaging(dt_coupling, OS%Time, OS%diag) + call mech_forcing_diags(OS%forces, dt_coupling, OS%grid, OS%diag, OS%forcing_CSp%handles) call disable_averaging(OS%diag) if (OS%fluxes%fluxes_used) then @@ -576,28 +719,20 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & ! call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid, & ! Ice_ocean_boundary%p, OS%press_to_z) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) + call coupler_type_send_data(Ocean_sfc%fields, OS%Time) call callTree_leave("update_ocean_model()") - end subroutine update_ocean_model -! NAME="update_ocean_model" -!======================================================================= -! -! -! -! write out restart file. -! Arguments: -! timestamp (optional, intent(in)) : A character string that represents the model time, -! used for writing restart. timestamp will prepend to -! the any restart file name as a prefix. -! -! -subroutine ocean_model_restart(OS, timestamp) +!> This subroutine writes out the ocean model restart file. +subroutine ocean_model_restart(OS, timestamp, restartname) type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the !! internal ocean state being saved to a restart file character(len=*), optional, intent(in) :: timestamp !< An optional timestamp string that should be !! prepended to the file name. (Currently this is unused.) + character(len=*), optional, intent(in) :: restartname !< Name of restart file to use + !! This option distinguishes the cesm interface from the + !! non-cesm interface if (.not.MOM_state_is_synchronized(OS%MOM_CSp)) & call MOM_error(WARNING, "End of MOM_main reached with inconsistent "//& @@ -607,54 +742,56 @@ subroutine ocean_model_restart(OS, timestamp) "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (BTEST(OS%Restart_control,1)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, .true., GV=OS%GV) - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir, .true.) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) - endif - endif - if (BTEST(OS%Restart_control,0)) then - call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & - OS%restart_CSp, GV=OS%GV) - call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & - OS%dirs%restart_output_dir) - if (OS%use_ice_shelf) then - call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) - endif - endif + if (present(restartname)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV, filename=restartname) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) ! Is this needed? + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, & + OS%dirs%restart_output_dir) + endif + else + if (BTEST(OS%Restart_control,1)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, .true., GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir, .true.) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir, .true.) + endif + endif + if (BTEST(OS%Restart_control,0)) then + call save_restart(OS%dirs%restart_output_dir, OS%Time, OS%grid, & + OS%restart_CSp, GV=OS%GV) + call forcing_save_restart(OS%forcing_CSp, OS%grid, OS%Time, & + OS%dirs%restart_output_dir) + if (OS%use_ice_shelf) then + call ice_shelf_save_restart(OS%Ice_shelf_CSp, OS%Time, OS%dirs%restart_output_dir) + endif + endif + end if end subroutine ocean_model_restart ! NAME="ocean_model_restart" -!======================================================================= -! -! -! -! Close down the ocean model -! - -!> Terminates the model run, saving the ocean state in a -!! restart file and deallocating any data associated with the ocean. +!> ocean_model_end terminates the model run, saving the ocean state in a restart +!! and deallocating any data associated with the ocean. subroutine ocean_model_end(Ocean_sfc, Ocean_state, Time) - type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is to be - !! deallocated upon termination. - type(ocean_state_type), pointer :: Ocean_state!< pointer to the structure containing the internal - ! !! ocean state to be deallocated upon termination. - type(time_type), intent(in) :: Time !< The model time, used for writing restarts. - + type(ocean_public_type), intent(inout) :: Ocean_sfc !< An ocean_public_type structure that is + !! to be deallocated upon termination. + type(ocean_state_type), pointer :: Ocean_state !< A pointer to the structure containing + !! the internal ocean state to be deallocated + !! upon termination. + type(time_type), intent(in) :: Time !< The model time, used for writing restarts. + + call ocean_model_save_restart(Ocean_state, Time) call diag_mediator_end(Time, Ocean_state%diag, end_diag_manager=.true.) ! print time stats call MOM_infra_end call MOM_end(Ocean_state%MOM_CSp) if (Ocean_state%use_ice_shelf) call ice_shelf_end(Ocean_state%Ice_shelf_CSp) - end subroutine ocean_model_end -! NAME="ocean_model_end" - -!======================================================================= !> ocean_model_save_restart causes restart files associated with the ocean to be !! written out. @@ -666,12 +803,6 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) !! write these restart files. character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time-stamp) !! to append to the restart file names. -! Arguments: Ocean_state - A structure containing the internal ocean state (in). -! (in) Time - The model time at this call. This is needed for mpp_write calls. -! (in, opt) directory - An optional directory into which to write these restart files. -! (in, opt) filename_suffix - An optional suffix (e.g., a time-stamp) to append -! to the restart file names. - ! Note: This is a new routine - it will need to exist for the new incremental ! checkpointing. It will also be called by ocean_model_end, giving the same ! restart behavior as now in FMS. @@ -685,11 +816,8 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) "was called with unused buoyancy fluxes. For conservation, the ocean "//& "restart files can only be created after the buoyancy forcing is applied.") - if (present(directory)) then - restart_dir = directory - else - restart_dir = OS%dirs%restart_output_dir - endif + if (present(directory)) then ; restart_dir = directory + else ; restart_dir = OS%dirs%restart_output_dir ; endif call save_restart(restart_dir, Time, OS%grid, OS%restart_CSp, GV=OS%GV) @@ -701,23 +829,25 @@ subroutine ocean_model_save_restart(OS, Time, directory, filename_suffix) end subroutine ocean_model_save_restart -!======================================================================= - -!> Initializes domain and state variables contained in the ocean public type. +!> Initialize the public ocean type subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, & gas_fields_ocn) - type(domain2D), intent(in) :: input_domain !< The FMS domain for the input structure - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state - type(diag_ctrl), intent(in) :: diag !< A structure used to control diagnostics. - logical, intent(in), optional :: maskmap(:,:) !< A pointer to an array indicating which - !! logical processors are actually used for the ocean code. + type(domain2D), intent(in) :: input_domain !< The ocean model domain description + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements are allocated here. + type(diag_ctrl), intent(in) :: diag !< A structure that regulates diagnsotic output + logical, dimension(:,:), & + optional, intent(in) :: maskmap !< A mask indicating which virtual processors + !! are actually in use. If missing, all are used. type(coupler_1d_bc_type), & optional, intent(in) :: gas_fields_ocn !< If present, this type describes the - !! ocean and surface-ice fields that will participate - !! in the calculation of additional gas or other - !! tracer fluxes. - ! local variables + !! ocean and surface-ice fields that will participate + !! in the calculation of additional gas or other + !! tracer fluxes. integer :: xsz, ysz, layout(2) + ! ice-ocean-boundary fields are always allocated using absolute indicies + ! and have no halos. integer :: isc, iec, jsc, jec call mpp_get_layout(input_domain,layout) @@ -757,25 +887,31 @@ subroutine initialize_ocean_public_type(input_domain, Ocean_sfc, diag, maskmap, end subroutine initialize_ocean_public_type -!> Translates the coupler's ocean_data_type into MOM6's surface state variable. -!! This may eventually be folded into the MOM6's code that calculates the -!! surface state in the first place. -subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) - type(surface), intent(inout) :: state - type(ocean_public_type), target, intent(inout) :: Ocean_sfc !< Ocean surface state - type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - real, optional, intent(in) :: patm(:,:) !< Atmospheric pressure. - real, optional, intent(in) :: press_to_z !< Factor to tranform atmospheric - !! pressure to z? - - ! local variables +!> This subroutine translates the coupler's ocean_data_type into MOM's +!! surface state variable. This may eventually be folded into the MOM +!! code that calculates the surface state in the first place. +!! Note the offset in the arrays because the ocean_data_type has no +!! halo points in its arrays and always uses absolute indicies. +subroutine convert_state_to_ocean_type(sfc_state, Ocean_sfc, G, patm, press_to_z) + type(surface), intent(inout) :: sfc_state !< A structure containing fields that + !! describe the surface state of the ocean. + type(ocean_public_type), & + target, intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface fields, whose elements + !! have their data set here. + type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure + real, optional, intent(in) :: patm(:,:) !< The pressure at the ocean surface, in Pa. + real, optional, intent(in) :: press_to_z !< A conversion factor between pressure and + !! ocean depth in m, usually 1/(rho_0*g), in m Pa-1. + + ! Local variables real :: IgR0 character(len=48) :: val_str integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd integer :: i, j, i0, j0, is, ie, js, je is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec - call pass_vector(state%u,state%v,G%Domain) + call pass_vector(sfc_state%u,sfc_state%v,G%Domain) call mpp_get_compute_domain(Ocean_sfc%Domain, isc_bnd, iec_bnd, & jsc_bnd, jec_bnd) @@ -786,55 +922,76 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) endif i0 = is - isc_bnd ; j0 = js - jsc_bnd - if (state%T_is_conT) then + if (sfc_state%T_is_conT) then ! Convert the surface T from conservative T to potential T. do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(state%SSS(i+i0,j+j0), & - state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET + Ocean_sfc%t_surf(i,j) = gsw_pt_from_ct(sfc_state%SSS(i+i0,j+j0), & + sfc_state%SST(i+i0,j+j0)) + CELSIUS_KELVIN_OFFSET enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%t_surf(i,j) = state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET + Ocean_sfc%t_surf(i,j) = sfc_state%SST(i+i0,j+j0) + CELSIUS_KELVIN_OFFSET enddo ; enddo endif - if (state%S_is_absS) then + if (sfc_state%S_is_absS) then ! Convert the surface S from absolute salinity to practical salinity. do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(state%SSS(i+i0,j+j0)) + Ocean_sfc%s_surf(i,j) = gsw_sp_from_sr(sfc_state%SSS(i+i0,j+j0)) enddo ; enddo else do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%s_surf(i,j) = state%SSS(i+i0,j+j0) + Ocean_sfc%s_surf(i,j) = sfc_state%SSS(i+i0,j+j0) enddo ; enddo endif - do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%sea_lev(i,j) = state%sea_lev(i+i0,j+j0) - Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) - if (present(patm)) & - Ocean_sfc%sea_lev(i,j) = Ocean_sfc%sea_lev(i,j) + patm(i,j) * press_to_z - if (associated(state%frazil)) & - Ocean_sfc%frazil(i,j) = state%frazil(i+i0,j+j0) - if (allocated(state%melt_potential)) & - Ocean_sfc%melt_potential(i,j) = state%melt_potential(i+i0,j+j0) - if (allocated(state%Hml)) & - Ocean_sfc%OBLD(i,j) = state%Hml(i+i0,j+j0) - enddo ; enddo + if (present(patm)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + patm(i,j) * press_to_z + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + else + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%sea_lev(i,j) = sfc_state%sea_lev(i+i0,j+j0) + Ocean_sfc%area(i,j) = G%areaT(i+i0,j+j0) + enddo ; enddo + endif + + if (associated(sfc_state%frazil)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%frazil(i,j) = sfc_state%frazil(i+i0,j+j0) + enddo ; enddo + endif + + if (allocated(sfc_state%melt_potential)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%melt_potential(i,j) = sfc_state%melt_potential(i+i0,j+j0) + enddo ; enddo + endif + + if (allocated(sfc_state%Hml)) then + do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd + Ocean_sfc%OBLD(i,j) = sfc_state%Hml(i+i0,j+j0) + enddo ; enddo + endif if (Ocean_sfc%stagger == AGRID) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I-1+i0,j+j0)) - Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0,J-1+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I-1+i0,j+j0)) + Ocean_sfc%v_surf(i,j) = G%mask2dT(i+i0,j+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0,J-1+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == BGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%u(I+i0,j+j0)+state%u(I+i0,j+j0+1)) - Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0)*0.5*(state%v(i+i0,J+j0)+state%v(i+i0+1,J+j0)) + Ocean_sfc%u_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%u(I+i0,j+j0)+sfc_state%u(I+i0,j+j0+1)) + Ocean_sfc%v_surf(i,j) = G%mask2dBu(I+i0,J+j0) * & + 0.5*(sfc_state%v(i+i0,J+j0)+sfc_state%v(i+i0+1,J+j0)) enddo ; enddo elseif (Ocean_sfc%stagger == CGRID_NE) then do j=jsc_bnd,jec_bnd ; do i=isc_bnd,iec_bnd - Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*state%u(I+i0,j+j0) - Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*state%v(i+i0,J+j0) + Ocean_sfc%u_surf(i,j) = G%mask2dCu(I+i0,j+j0)*sfc_state%u(I+i0,j+j0) + Ocean_sfc%v_surf(i,j) = G%mask2dCv(i+i0,J+j0)*sfc_state%v(i+i0,J+j0) enddo ; enddo else write(val_str, '(I8)') Ocean_sfc%stagger @@ -842,25 +999,25 @@ subroutine convert_state_to_ocean_type(state, Ocean_sfc, G, patm, press_to_z) "Ocean_sfc%stagger has the unrecognized value of "//trim(val_str)) endif - if (coupler_type_initialized(state%tr_fields)) then + if (coupler_type_initialized(sfc_state%tr_fields)) then if (.not.coupler_type_initialized(Ocean_sfc%fields)) then call MOM_error(FATAL, "convert_state_to_ocean_type: "//& "Ocean_sfc%fields has not been initialized.") endif - call coupler_type_copy_data(state%tr_fields, Ocean_sfc%fields) + call coupler_type_copy_data(sfc_state%tr_fields, Ocean_sfc%fields) endif end subroutine convert_state_to_ocean_type -!> This subroutine extracts the surface properties from the ocean's internal +!> This subroutine extracts the surface properties from the ocean's internal !! state and stores them in the ocean type returned to the calling ice model. !! It has to be separate from the ocean_initialization call because the coupler !! module allocates the space for some of these variables. subroutine ocean_model_init_sfc(OS, Ocean_sfc) - type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the - !! internal ocean state (in). - type(ocean_public_type), intent(inout) :: Ocean_sfc !< Ocean surface state - + type(ocean_state_type), pointer :: OS !< The structure with the complete ocean state + type(ocean_public_type), intent(inout) :: Ocean_sfc !< A structure containing various publicly + !! visible ocean surface properties after initialization, whose + !! elements have their data set here. integer :: is, ie, js, je is = OS%grid%isc ; ie = OS%grid%iec ; js = OS%grid%jsc ; je = OS%grid%jec @@ -872,9 +1029,6 @@ subroutine ocean_model_init_sfc(OS, Ocean_sfc) call convert_state_to_ocean_type(OS%sfc_state, Ocean_sfc, OS%grid) end subroutine ocean_model_init_sfc -! - -!======================================================================= !> ocean_model_flux_init is used to initialize properties of the air-sea fluxes !! as determined by various run-time parameters. It can be called from @@ -899,16 +1053,13 @@ subroutine ocean_model_flux_init(OS, verbosity) end subroutine ocean_model_flux_init -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! -! Ocean_stock_pe - returns stocks of heat, water, etc. for conservation checks.! -!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~! !> Ocean_stock_pe - returns the integrated stocks of heat, water, etc. for conservation checks. !! Because of the way FMS is coded, only the root PE has the integrated amount, !! while all other PEs get 0. subroutine Ocean_stock_pe(OS, index, value, time_index) use stock_constants_mod, only : ISTOCK_WATER, ISTOCK_HEAT,ISTOCK_SALT type(ocean_state_type), pointer :: OS !< A structure containing the internal ocean state. - !! The data in OS is intent(in). + !! The data in OS is intent in. integer, intent(in) :: index !< The stock index for the quantity of interest. real, intent(out) :: value !< Sum returned for the conservation quantity of interest. integer, optional, intent(in) :: time_index !< An unused optional argument, present only for @@ -944,13 +1095,18 @@ subroutine Ocean_stock_pe(OS, index, value, time_index) end subroutine Ocean_stock_pe +!> This subroutine extracts a named 2-D field from the ocean surface or public type subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) use MOM_constants, only : CELSIUS_KELVIN_OFFSET - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real, dimension(isc:,jsc:), intent(out):: array2D - integer , intent(in) :: isc,jsc + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real, dimension(isc:,jsc:), intent(out):: array2D !< The values of the named field, it must + !! cover only the computational domain + integer , intent(in) :: isc !< The starting i-index of array2D + integer , intent(in) :: jsc !< The starting j-index of array2D integer :: g_isc, g_iec, g_jsc, g_jec,g_isd, g_ied, g_jsd, g_jed, i, j @@ -1006,33 +1162,39 @@ subroutine ocean_model_data2D_get(OS,Ocean, name, array2D,isc,jsc) case('sin_rot') array2D(isc:,jsc:) = OS%grid%sin_rot(g_isc:g_iec,g_jsc:g_jec) ! =0 case default - call MOM_error(FATAL,'ocean_model_data2D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data2D: unknown argument name='//name) end select end subroutine ocean_model_data2D_get -subroutine ocean_model_data1D_get(OS,Ocean, name, value) - type(ocean_state_type), pointer :: OS - type(ocean_public_type), intent(in) :: Ocean - character(len=*) , intent(in) :: name - real , intent(out):: value +!> This subroutine extracts a named scalar field from the ocean surface or public type +subroutine ocean_model_data1D_get(OS, Ocean, name, value) + type(ocean_state_type), pointer :: OS !< A pointer to the structure containing the + !! internal ocean state (intent in). + type(ocean_public_type), intent(in) :: Ocean !< A structure containing various publicly + !! visible ocean surface fields. + character(len=*) , intent(in) :: name !< The name of the field to extract + real , intent(out):: value !< The value of the named field if (.not.associated(OS)) return if (.not.OS%is_ocean_pe) return select case(name) case('c_p') - value = OS%C_p + value = OS%C_p case default - call MOM_error(FATAL,'ocean_model_data1D_get: unknown argument name='//name) + call MOM_error(FATAL,'get_ocean_grid_data1D: unknown argument name='//name) end select + end subroutine ocean_model_data1D_get +!> Write out FMS-format checsums on fields from the ocean surface state subroutine ocean_public_type_chksum(id, timestep, ocn) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ocean_public_type), intent(in) :: ocn - integer :: n,m, outunit + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ocean_public_type), intent(in) :: ocn !< A structure containing various publicly + !! visible ocean surface fields. + integer :: n, m, outunit outunit = stdout() @@ -1043,28 +1205,20 @@ subroutine ocean_public_type_chksum(id, timestep, ocn) write(outunit,100) 'ocean%v_surf ',mpp_chksum(ocn%v_surf ) write(outunit,100) 'ocean%sea_lev ',mpp_chksum(ocn%sea_lev) write(outunit,100) 'ocean%frazil ',mpp_chksum(ocn%frazil ) - write(outunit,100) 'ocean%OBLD ',mpp_chksum(ocn%OBLD ) write(outunit,100) 'ocean%melt_potential ',mpp_chksum(ocn%melt_potential) call coupler_type_write_chksums(ocn%fields, outunit, 'ocean%') 100 FORMAT(" CHECKSUM::",A20," = ",Z20) + end subroutine ocean_public_type_chksum -!======================================================================= -! -! -! -! Obtain the ocean grid. -! -! subroutine get_ocean_grid(OS, Gridp) + ! Obtain the ocean grid. type(ocean_state_type) :: OS - type(ocean_grid_type) , pointer :: Gridp + type(ocean_grid_type) , pointer :: Gridp Gridp => OS%grid return - end subroutine get_ocean_grid -! NAME="get_ocean_grid" end module MOM_ocean_model diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 38041a8a65..0e2b82d87b 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -205,7 +205,7 @@ module MOM_surface_forcing !! See \ref section_ocn_import for a summary of the surface fluxes that are !! passed from MCT to MOM6, including fluxes that need to be included in !! the future. -subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & +subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sfc_state, restore_salt, restore_temp) type(ice_ocean_boundary_type), & @@ -215,6 +215,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, Time, G, US, CS, & type(forcing), intent(inout) :: fluxes !< A structure containing pointers to !! all possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. + integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the !! salinity to the right time, when it is being restored. type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure From 3135f6291377dfc2c19dee64aab4e4269ae52891 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 11:51:09 -0600 Subject: [PATCH 4/6] removed trailing whitespace --- config_src/mct_driver/MOM_ocean_model.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index aa375809c2..69deaf4ab9 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -140,7 +140,7 @@ module MOM_ocean_model !> The ocean_state_type contains all information about the state of the ocean, !! with a format that is private so it can be readily changed without disrupting !! other coupled components. -type, public :: ocean_state_type ; +type, public :: ocean_state_type ; ! This type is private, and can therefore vary between different ocean models. logical :: is_ocean_PE = .false. !< True if this is an ocean PE. type(time_type) :: Time !< The ocean model's time and master clock. @@ -539,7 +539,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & call convert_IOB_to_fluxes(Ice_ocean_boundary, OS%fluxes, index_bnds, OS%Time, & OS%grid, OS%US, OS%forcing_CSp, OS%sfc_state, & OS%restore_salinity, OS%restore_temp) - + ! Add ice shelf fluxes if (OS%use_ice_shelf) then if (do_thermo) & From f72454b8b0e529719221ea968c5a684a29817858 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 18:12:28 -0600 Subject: [PATCH 5/6] changes to have minimal differences between nuopc and mct --- config_src/mct_driver/MOM_ocean_model.F90 | 34 - config_src/mct_driver/MOM_surface_forcing.F90 | 777 +++++++++--------- config_src/mct_driver/ocn_cap_methods.F90 | 9 +- config_src/mct_driver/ocn_comp_mct.F90 | 61 +- config_src/nuopc_driver/MOM_ocean_model.F90 | 99 ++- .../nuopc_driver/MOM_surface_forcing.F90 | 7 +- 6 files changed, 505 insertions(+), 482 deletions(-) diff --git a/config_src/mct_driver/MOM_ocean_model.F90 b/config_src/mct_driver/MOM_ocean_model.F90 index 69deaf4ab9..2a984916aa 100644 --- a/config_src/mct_driver/MOM_ocean_model.F90 +++ b/config_src/mct_driver/MOM_ocean_model.F90 @@ -353,19 +353,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call get_param(param_file, mdl, "ICEBERGS_APPLY_RIGID_BOUNDARY", OS%icebergs_alter_ocean, & "If true, allows icebergs to change boundary condition felt by ocean", default=.false.) - ! MV: question for Gustavo - what to do with the following? - - ! 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, mdl, "DENSITY_ICEBERGS", OS%density_iceberg, & - ! "A typical density of icebergs.", units="kg m-3", default=917.0) - ! 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, mdl, "BERG_AREA_THRESHOLD", OS%berg_area_threshold, & - ! "Fraction of grid cell which iceberg must occupy, so that fluxes "//& - ! "below berg are set to zero. Not applied for negative "//& - ! " values.", units="non-dim", default=-1.0) - OS%press_to_z = 1.0/(Rho0*G_Earth) call get_param(param_file, mdl, "HFREEZE", HFrz, & @@ -407,13 +394,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i call MOM_wave_interface_init_lite(param_file) endif - ! MV - what to do with the following? - ! if (OS%icebergs_apply_rigid_boundary) then - ! !call allocate_forcing_type(OS%grid, OS%fluxes, iceberg=.true.) - ! !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - ! if (.not. OS%use_ice_shelf) call allocate_forcing_type(OS%grid, OS%fluxes, ustar=.true., shelf=.true.) - ! endif - if (associated(OS%grid%Domain%maskmap)) then call initialize_ocean_public_type(OS%grid%Domain%mpp_domain, Ocean_sfc, & OS%diag, maskmap=OS%grid%Domain%maskmap, & @@ -556,13 +536,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - ! GMM, check ocean_model_MOM.F90 to enable the following option - !if (OS%icebergs_apply_rigid_boundary) then - ! This assumes that the iceshelf and ocean are on the same grid. I hope this is true. - ! call add_berg_flux_to_shelf(OS%grid, OS%forces,OS%fluxes,OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) - !endif - ! Fields that exist in both the forcing and mech_forcing types must be copied. call copy_common_forcing_fields(OS%forces, OS%fluxes, OS%grid) @@ -598,13 +571,6 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & OS%sfc_state, dt_coupling, OS%marine_ice_CSp) endif - ! GMM, check ocean_model_MOM.F90 to enable the following option - !if (OS%icebergs_apply_rigid_boundary) then - !This assumes that the iceshelf and ocean are on the same grid. I hope this is true - ! call add_berg_flux_to_shelf(OS%grid, OS%forces, OS%flux_tmp, OS%use_ice_shelf,OS%density_iceberg, & - ! OS%kv_iceberg, OS%latent_heat_fusion, OS%sfc_state, dt_coupling, OS%berg_area_threshold) - !endif - call forcing_accumulate(OS%flux_tmp, OS%forces, OS%fluxes, dt_coupling, OS%grid, weight) ! Some of the fields that exist in both the forcing and mech_forcing types diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 0e2b82d87b..0fc0efe532 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -38,42 +38,42 @@ module MOM_surface_forcing use coupler_types_mod, only : coupler_type_copy_data use data_override_mod, only : data_override_init, data_override use fms_mod, only : stdout -use fms_mod, only : read_data use mpp_mod, only : mpp_chksum use time_interp_external_mod, only : init_external_field, time_interp_external use time_interp_external_mod, only : time_interp_external_init -! MCT specfic routines -use ocn_cpl_indices, only : cpl_indices_type - implicit none ; private #include -public IOB_allocate public convert_IOB_to_fluxes public convert_IOB_to_forces public surface_forcing_init -public ice_ocn_bnd_type_chksum public forcing_save_restart -public apply_flux_adjustments +public ice_ocn_bnd_type_chksum + +private apply_flux_adjustments +private apply_force_adjustments +private surface_forcing_end !> Contains pointers to the forcing fields which may be used to drive MOM. !! All fluxes are positive downward. -type, public :: surface_forcing_CS ; +type, public :: surface_forcing_CS ; private integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integer values !! from MOM_domains) to indicate the staggering of !! the winds that are being provided in calls to - !! update_ocean_model. CIME uses AGRID, so this option - !! is being hard coded for now. - logical :: use_temperature !< If true, temp and saln used as state variables + !! update_ocean_model. + logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). + ! smg: remove when have A=B code reconciled logical :: bulkmixedlayer !< If true, model based on bulk mixed layer code - real :: Rho0 !< Boussinesq reference density (kg/m^3) - real :: area_surf = -1.0 !< total ocean surface area (m^2) - real :: latent_heat_fusion ! latent heat of fusion (J/kg) - real :: latent_heat_vapor ! latent heat of vaporization (J/kg) + + real :: Rho0 !< Boussinesq reference density [kg/m^3] + real :: area_surf = -1.0 !< total ocean surface area [m^2] + real :: latent_heat_fusion !< latent heat of fusion [J/kg] + real :: latent_heat_vapor !< latent heat of vaporization [J/kg] + real :: max_p_surf !< maximum surface pressure that can be !! exerted by the atmosphere and floating sea-ice, !! in Pa. This is needed because the FMS coupling @@ -84,127 +84,122 @@ module MOM_surface_forcing !! the correction for the atmospheric (and sea-ice) !! pressure limited by max_p_surf instead of the !! full atmospheric pressure. The default is true. - real :: gust_const !< constant unresolved background gustiness for ustar (Pa) + real :: gust_const !< constant unresolved background gustiness for ustar [Pa] logical :: read_gust_2d !< If true, use a 2-dimensional gustiness supplied !! from an input file. real, pointer, dimension(:,:) :: & TKE_tidal => NULL(), & !< turbulent kinetic energy introduced to the - !! bottom boundary layer by drag on the tidal flows, - !! in W m-2. + !! bottom boundary layer by drag on the tidal flows [W m-2] gust => NULL(), & !< spatially varying unresolved background - !! gustiness that contributes to ustar (Pa). + !! gustiness that contributes to ustar [Pa]. !! gust is used when read_gust_2d is true. - ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m s-1] - real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) - real :: utide !< constant tidal velocity to use if read_tideamp - !! is false [m s-1]. + ustar_tidal => NULL() !< tidal contribution to the bottom friction velocity [m/s] + real :: cd_tides !< drag coefficient that applies to the tides (nondimensional) + real :: utide !< constant tidal velocity to use if read_tideamp + !! is false [m s-1] logical :: read_tideamp !< If true, spatially varying tidal amplitude read from a file. logical :: rigid_sea_ice !< If true, sea-ice exerts a rigidity that acts !! to damp surface deflections (especially surface !! gravity waves). The default is false. - real :: Kv_sea_ice !< viscosity in sea-ice that resists sheared vertical motions (m^2/s) - real :: density_sea_ice !< typical density of sea-ice (kg/m^3). The value is - !! only used to convert the ice pressure into - !! appropriate units for use with Kv_sea_ice. + real :: Kv_sea_ice !! viscosity in sea-ice that resists sheared vertical motions [m^2/s] + real :: density_sea_ice !< typical density of sea-ice [kg/m^3]. The value is + !! only used to convert the ice pressure into + !! appropriate units for use with Kv_sea_ice. real :: rigid_sea_ice_mass !< A mass per unit area of sea-ice beyond which !! sea-ice viscosity becomes effective, in kg m-2, - !! typically of order 1000 kg m-2. + !! typically of order 1000 [kg m-2]. logical :: allow_flux_adjustments !< If true, use data_override to obtain flux adjustments - real :: Flux_const !< piston velocity for surface restoring [m s-1] - logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux - logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) + real :: Flux_const !< piston velocity for surface restoring [m/s] + logical :: salt_restore_as_sflux !< If true, SSS restore as salt flux instead of water flux + logical :: adjust_net_srestore_to_zero !< adjust srestore to zero (for both salt_flux or vprec) logical :: adjust_net_srestore_by_scaling !< adjust srestore w/o moving zero contour logical :: adjust_net_fresh_water_to_zero !< adjust net surface fresh-water (w/ restoring) to zero - logical :: use_net_FW_adjustment_sign_bug ! use the wrong sign when adjusting net FW + logical :: use_net_FW_adjustment_sign_bug !< use the wrong sign when adjusting net FW logical :: adjust_net_fresh_water_by_scaling !< adjust net surface fresh-water w/o moving zero contour logical :: mask_srestore_under_ice !< If true, use an ice mask defined by frazil - !! criteria for salinity restoring. - real :: ice_salt_concentration !< salt concentration for sea ice (kg/kg) + !< criteria for salinity restoring. + real :: ice_salt_concentration !< salt concentration for sea ice [kg/kg] logical :: mask_srestore_marginal_seas !< if true, then mask SSS restoring in marginal seas real :: max_delta_srestore !< maximum delta salinity used for restoring real :: max_delta_trestore !< maximum delta sst used for restoring - real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring + real, pointer, dimension(:,:) :: basin_mask => NULL() !< mask for SSS restoring by basin type(diag_ctrl), pointer :: diag !< structure to regulate diagnostic output timing character(len=200) :: inputdir !< directory where NetCDF input files are character(len=200) :: salt_restore_file !< filename for salt restoring data character(len=30) :: salt_restore_var_name !< name of surface salinity in salt_restore_file - logical :: mask_srestore ! if true, apply a 2-dimensional mask to the surface - ! salinity restoring fluxes. The masking file should be - ! in inputdir/salt_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: srestore_mask => NULL() ! mask for SSS restoring + logical :: mask_srestore !< if true, apply a 2-dimensional mask to the surface + !< salinity restoring fluxes. The masking file should be + !< in inputdir/salt_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: srestore_mask => NULL() !< mask for SSS restoring character(len=200) :: temp_restore_file !< filename for sst restoring data character(len=30) :: temp_restore_var_name !< name of surface temperature in temp_restore_file - logical :: mask_trestore ! if true, apply a 2-dimensional mask to the surface - ! temperature restoring fluxes. The masking file should be - ! in inputdir/temp_restore_mask.nc and the field should - ! be named 'mask' - real, pointer, dimension(:,:) :: trestore_mask => NULL() ! mask for SST restoring + logical :: mask_trestore !< if true, apply a 2-dimensional mask to the surface + !! temperature restoring fluxes. The masking file should be + !! in inputdir/temp_restore_mask.nc and the field should + !! be named 'mask' + real, pointer, dimension(:,:) :: trestore_mask => NULL() !< mask for SST restoring integer :: id_srestore = -1 !< id number for time_interp_external. integer :: id_trestore = -1 !< id number for time_interp_external. - type(forcing_diags), public :: handles !< diagnostics handles + + ! Diagnostics handles + type(forcing_diags), public :: handles + !### type(ctrl_forcing_CS), pointer :: ctrl_forcing_CSp => NULL() - type(MOM_restart_CS), pointer :: restart_CSp => NULL() !< restart pointer - type(user_revise_forcing_CS), pointer :: urf_CS => NULL()!< user revise pointer + type(MOM_restart_CS), pointer :: restart_CSp => NULL() + type(user_revise_forcing_CS), pointer :: urf_CS => NULL() end type surface_forcing_CS -! ice_ocean_boundary_type is a structure corresponding to forcing, but with -! the elements, units, and conventions that exactly conform to the use for -! MOM-based coupled models. +!> Structure corresponding to forcing, but with the elements, units, and conventions +!! that exactly conform to the use for MOM-based coupled models. type, public :: ice_ocean_boundary_type - real, pointer, dimension(:,:) :: latent_flux =>NULL() !< latent flux (W/m2) - real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff (W/m2) - real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff (W/m2) - real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress (Pa) - real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress (Pa) - real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux (W/m2) - real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting (kg/m2/s) - real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux (kg/m2/s) - real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux (kg/m2/s) - real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation (W/m2) - real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip (kg/m2/s) - real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip (kg/m2/s) - real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff (kg/m2/s) - real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff (kg/m2/s) - real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m s-1] - real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs(m2/m2) - real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) - real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff (W/m2) - real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff (W/m2) - real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere - !< on ocean surface (Pa) - real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice (kg/m2) - real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and - !! ice-shelves, expressed as a coefficient - !! for divergence damping, as determined - !! outside of the ocean model in (m3/s) - integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT - type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of - !! named fields used for passive tracer fluxes. - integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of - !! wind stresses. This flag may be set by the - !! flux-exchange code, based on what the sea-ice - !! model is providing. Otherwise, the value from - !! the surface_forcing_CS is used. + real, pointer, dimension(:,:) :: rofl_flux =>NULL() !< liquid runoff [W/m2] + real, pointer, dimension(:,:) :: rofi_flux =>NULL() !< ice runoff [W/m2] + real, pointer, dimension(:,:) :: u_flux =>NULL() !< i-direction wind stress [Pa] + real, pointer, dimension(:,:) :: v_flux =>NULL() !< j-direction wind stress [Pa] + real, pointer, dimension(:,:) :: t_flux =>NULL() !< sensible heat flux [W/m2] + real, pointer, dimension(:,:) :: q_flux =>NULL() !< specific humidity flux [kg/m2/s] + real, pointer, dimension(:,:) :: salt_flux =>NULL() !< salt flux [kg/m2/s] + real, pointer, dimension(:,:) :: seaice_melt_heat =>NULL() !< sea ice and snow melt heat flux [W/m2] + real, pointer, dimension(:,:) :: seaice_melt =>NULL() !< water flux due to sea ice and snow melting [kg/m2/s] + real, pointer, dimension(:,:) :: lw_flux =>NULL() !< long wave radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dir =>NULL() !< direct visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_vis_dif =>NULL() !< diffuse visible sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dir =>NULL() !< direct Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: sw_flux_nir_dif =>NULL() !< diffuse Near InfraRed sw radiation [W/m2] + real, pointer, dimension(:,:) :: lprec =>NULL() !< mass flux of liquid precip [kg/m2/s] + real, pointer, dimension(:,:) :: fprec =>NULL() !< mass flux of frozen precip [kg/m2/s] + real, pointer, dimension(:,:) :: runoff =>NULL() !< mass flux of liquid runoff [kg/m2/s] + real, pointer, dimension(:,:) :: calving =>NULL() !< mass flux of frozen runoff [kg/m2/s] + real, pointer, dimension(:,:) :: ustar_berg =>NULL() !< frictional velocity beneath icebergs [m/s] + real, pointer, dimension(:,:) :: area_berg =>NULL() !< area covered by icebergs[m2/m2] + real, pointer, dimension(:,:) :: mass_berg =>NULL() !< mass of icebergs(kg/m2) + real, pointer, dimension(:,:) :: runoff_hflx =>NULL() !< heat content of liquid runoff [W/m2] + real, pointer, dimension(:,:) :: calving_hflx =>NULL() !< heat content of frozen runoff [W/m2] + real, pointer, dimension(:,:) :: p =>NULL() !< pressure of overlying ice and atmosphere + !< on ocean surface [Pa] + real, pointer, dimension(:,:) :: mi =>NULL() !< mass of ice [kg/m2] + real, pointer, dimension(:,:) :: ice_rigidity =>NULL() !< rigidity of the sea ice, sea-ice and + !! ice-shelves, expressed as a coefficient + !! for divergence damping, as determined + !! outside of the ocean model in [m3/s] + integer :: xtype !< The type of the exchange - REGRID, REDIST or DIRECT + type(coupler_2d_bc_type) :: fluxes !< A structure that may contain an array of + !! named fields used for passive tracer fluxes. + integer :: wind_stagger = -999 !< A flag indicating the spatial discretization of + !! wind stresses. This flag may be set by the + !! flux-exchange code, based on what the sea-ice + !! model is providing. Otherwise, the value from + !! the surface_forcing_CS is used. end type ice_ocean_boundary_type integer :: id_clock_forcing -!======================================================================= contains -!======================================================================= - -!> This function has a few purposes: 1) it allocates and initializes the data -!! in the fluxes structure; 2) it imports surface fluxes using data from -!! the coupler; and 3) it can apply restoring in SST and SSS. -!! See \ref section_ocn_import for a summary of the surface fluxes that are -!! passed from MCT to MOM6, including fluxes that need to be included in -!! the future. + +!> This subroutine translates the Ice_ocean_boundary_type into a MOM +!! thermodynamic forcing type, including changes of units, sign conventions, +!! and putting the fields into arrays with MOM-standard halos. subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & sfc_state, restore_salt, restore_temp) @@ -212,8 +207,8 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & target, intent(in) :: IOB !< An ice-ocean boundary type with fluxes to drive !! the ocean in a coupled model - type(forcing), intent(inout) :: fluxes !< A structure containing pointers to - !! all possible mass, heat or salt flux forcing fields. + type(forcing), intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. !! Unused fields have NULL ptrs. integer, dimension(4), intent(in) :: index_bounds !< The i- and j- size of the arrays in IOB. type(time_type), intent(in) :: Time !< The time of the fluxes, used for interpolating the @@ -229,34 +224,37 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & - data_restore, & ! The surface value toward which to restore (g/kg or degC) - SST_anom, & ! Instantaneous sea surface temperature anomalies from a target value (deg C) - SSS_anom, & ! Instantaneous sea surface salinity anomalies from a target value (g/kg) - SSS_mean, & ! A (mean?) salinity about which to normalize local salinity - ! anomalies when calculating restorative precipitation anomalies (g/kg) - PmE_adj, & ! The adjustment to PminusE that will cause the salinity - ! to be restored toward its target value (kg/(m^2 * s)) - net_FW, & ! The area integrated net freshwater flux into the ocean (kg/s) - net_FW2, & ! The area integrated net freshwater flux into the ocean (kg/s) - work_sum, & ! A 2-d array that is used as the work space for a global - ! sum, used with units of m2 or (kg/s) - open_ocn_mask ! a binary field indicating where ice is present based on frazil criteria - - integer :: i, j, k, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 + data_restore, & !< The surface value toward which to restore [g/kg or degC] + SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C] + SSS_anom, & !< Instantaneous sea surface salinity anomalies from a target value [g/kg] + SSS_mean, & !< A (mean?) salinity about which to normalize local salinity + !! anomalies when calculating restorative precipitation anomalies [g/kg] + PmE_adj, & !< The adjustment to PminusE that will cause the salinity + !! to be restored toward its target value [kg/(m^2 * s)] + net_FW, & !< The area integrated net freshwater flux into the ocean [kg/s] + net_FW2, & !< The area integrated net freshwater flux into the ocean [kg/s] + work_sum, & !< A 2-d array that is used as the work space for a global + !! sum, used with units of m2 or [kg/s] + open_ocn_mask !< a binary field indicating where ice is present based on frazil criteria + + integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer + integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd - logical :: restore_salinity ! local copy of the argument restore_salt, if it - ! is present, or false (no restoring) otherwise. - logical :: restore_sst ! local copy of the argument restore_temp, if it - ! is present, or false (no restoring) otherwise. - real :: delta_sss ! temporary storage for sss diff from restoring value - real :: delta_sst ! temporary storage for sst diff from restoring value + logical :: restore_salinity !< local copy of the argument restore_salt, if it + !! is present, or false (no restoring) otherwise. + logical :: restore_sst !< local copy of the argument restore_temp, if it + !! is present, or false (no restoring) otherwise. + real :: delta_sss !< temporary storage for sss diff from restoring value + real :: delta_sst !< temporary storage for sst diff from restoring value - real :: C_p ! heat capacity of seawater ( J/(K kg) ) - real :: sign_for_net_FW_bug ! Should be +1. but an old bug can be recovered by using -1. + real :: C_p !< heat capacity of seawater ( J/(K kg) ) + real :: sign_for_net_FW_bug !< Should be +1. but an old bug can be recovered by using -1. call cpu_clock_begin(id_clock_forcing) + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed @@ -291,6 +289,11 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & call safe_alloc_ptr(fluxes%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%p_surf_full,isd,ied,jsd,jed) + if (CS%use_limited_P_SSH) then + fluxes%p_surf_SSH => fluxes%p_surf + else + fluxes%p_surf_SSH => fluxes%p_surf_full + endif call safe_alloc_ptr(fluxes%salt_flux,isd,ied,jsd,jed) call safe_alloc_ptr(fluxes%salt_flux_in,isd,ied,jsd,jed) @@ -314,11 +317,26 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & fluxes%dt_buoy_accum = 0.0 endif ! endif for allocation and initialization + + if (((associated(IOB%ustar_berg) .and. (.not.associated(fluxes%ustar_berg))) & + .or. (associated(IOB%area_berg) .and. (.not.associated(fluxes%area_berg)))) & + .or. (associated(IOB%mass_berg) .and. (.not.associated(fluxes%mass_berg)))) & + call allocate_forcing_type(G, fluxes, iceberg=.true.) + + if ((.not.coupler_type_initialized(fluxes%tr_fluxes)) .and. & + coupler_type_initialized(IOB%fluxes)) & + call coupler_type_spawn(IOB%fluxes, fluxes%tr_fluxes, & + (/is,is,ie,ie/), (/js,js,je,je/)) + ! It might prove valuable to use the same array extents as the rest of the + ! ocean model, rather than using haloless arrays, in which case the last line + ! would be: ( (/isd,is,ie,ied/), (/jsd,js,je,jed/)) + if (CS%allow_flux_adjustments) then fluxes%heat_added(:,:)=0.0 fluxes%salt_flux_added(:,:)=0.0 endif + ! allocation and initialization on first call to this routine if (CS%area_surf < 0.0) then do j=js,je ; do i=is,ie work_sum(i,j) = G%areaT(i,j) * G%mask2dT(i,j) @@ -346,7 +364,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & delta_sss = data_restore(i,j)- sfc_state%SSS(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) fluxes%salt_flux(i,j) = 1.e-3*G%mask2dT(i,j) * (CS%Rho0*CS%Flux_const)* & - (CS%basin_mask(i,j)*open_ocn_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 + (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j)) *delta_sss ! kg Salt m-2 s-1 enddo; enddo if (CS%adjust_net_srestore_to_zero) then if (CS%adjust_net_srestore_by_scaling) then @@ -364,7 +382,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (G%mask2dT(i,j) > 0.5) then delta_sss = sfc_state%SSS(i,j) - data_restore(i,j) delta_sss = sign(1.0,delta_sss)*min(abs(delta_sss),CS%max_delta_srestore) - fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j))* & + fluxes%vprec(i,j) = (CS%basin_mask(i,j)*open_ocn_mask(i,j)*CS%srestore_mask(i,j))* & (CS%Rho0*CS%Flux_const) * & delta_sss / (0.5*(sfc_state%SSS(i,j) + data_restore(i,j))) endif @@ -390,77 +408,79 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & do j=js,je ; do i=is,ie delta_sst = data_restore(i,j)- sfc_state%SST(i,j) delta_sst = sign(1.0,delta_sst)*min(abs(delta_sst),CS%max_delta_trestore) - fluxes%heat_added(i,j) = G%mask2dT(i,j) * (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 + fluxes%heat_added(i,j) = G%mask2dT(i,j) * CS%trestore_mask(i,j) * & + (CS%Rho0*fluxes%C_p) * delta_sst * CS%Flux_const ! W m-2 enddo; enddo endif - ! obtain fluxes from IOB + ! obtain fluxes from IOB; note the staggering of indices i0 = 0; j0 = 0 do j=js,je ; do i=is,ie ! liquid precipitation (rain) - if (associated(fluxes%lprec)) & - fluxes%lprec(i,j) = G%mask2dT(i,j) * IOB%lprec(i-i0,j-j0) + if (associated(IOB%lprec)) & + fluxes%lprec(i,j) = IOB%lprec(i-i0,j-j0) * G%mask2dT(i,j) ! frozen precipitation (snow) - if (associated(fluxes%fprec)) & - fluxes%fprec(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0) + if (associated(IOB%fprec)) & + fluxes%fprec(i,j) = IOB%fprec(i-i0,j-j0) * G%mask2dT(i,j) ! evaporation - if (associated(fluxes%evap)) & - fluxes%evap(i,j) = G%mask2dT(i,j) * IOB%q_flux(i-i0,j-j0) + if (associated(IOB%q_flux)) & + fluxes%evap(i,j) = IOB%q_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! river runoff flux - if (associated(fluxes%lrunoff)) & - fluxes%lrunoff(i,j) = G%mask2dT(i,j) * IOB%rofl_flux(i-i0,j-j0) + ! liquid runoff flux + if (associated(IOB%rofl_flux)) then + fluxes%lrunoff(i,j) = IOB%rofl_flux(i-i0,j-j0) * G%mask2dT(i,j) + else if (associated(IOB%runoff)) then + fluxes%lrunoff(i,j) = IOB%runoff(i-i0,j-j0) * G%mask2dT(i,j) + end if ! ice runoff flux - if (associated(fluxes%frunoff)) & - fluxes%frunoff(i,j) = G%mask2dT(i,j) * IOB%rofi_flux(i-i0,j-j0) - - ! GMM, we don't have an icebergs yet so the following is not needed - !if (((associated(IOB%ustar_berg) .and. (.not. associated(fluxes%ustar_berg))) & - ! .or. (associated(IOB%area_berg) .and. (.not. associated(fluxes%area_berg)))) & - ! .or. (associated(IOB%mass_berg) .and. (.not. associated(fluxes%mass_berg)))) & - ! call allocate_forcing_type(G, fluxes, iceberg=.true.) - !if (associated(IOB%ustar_berg)) & - ! fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) - !if (associated(IOB%area_berg)) & - ! fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) - !if (associated(IOB%mass_berg)) & - ! fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + if (associated(IOB%rofi_flux)) then + fluxes%frunoff(i,j) = IOB%rofi_flux(i-i0,j-j0) * G%mask2dT(i,j) + else if (associated(IOB%calving)) then + fluxes%frunoff(i,j) = IOB%calving(i-i0,j-j0) * G%mask2dT(i,j) + end if + + if (associated(IOB%ustar_berg)) & + fluxes%ustar_berg(i,j) = US%m_to_Z * IOB%ustar_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%area_berg)) & + fluxes%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%mass_berg)) & + fluxes%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) ! GMM, cime does not not have an equivalent for heat_content_lrunoff and ! heat_content_frunoff. I am seeting these to zero for now. if (associated(fluxes%heat_content_lrunoff)) & fluxes%heat_content_lrunoff(i,j) = 0.0 * G%mask2dT(i,j) - if (associated(fluxes%heat_content_frunoff)) & fluxes%heat_content_frunoff(i,j) = 0.0 * G%mask2dT(i,j) + if (associated(IOB%calving_hflx)) & + fluxes%heat_content_frunoff(i,j) = IOB%calving_hflx(i-i0,j-j0) * G%mask2dT(i,j) + ! longwave radiation, sum up and down (W/m2) - if (associated(fluxes%LW)) & - fluxes%LW(i,j) = G%mask2dT(i,j) * IOB%lw_flux(i-i0,j-j0) + if (associated(IOB%lw_flux)) & + fluxes%LW(i,j) = IOB%lw_flux(i-i0,j-j0) * G%mask2dT(i,j) ! sensible heat flux (W/m2) - if (associated(fluxes%sens)) & - fluxes%sens(i,j) = G%mask2dT(i,j) * IOB%t_flux(i-i0,j-j0) + if (associated(IOB%t_flux)) & + fluxes%sens(i,j) = IOB%t_flux(i-i0,j-j0) * G%mask2dT(i,j) - ! sea ice and snow melt heat flux (W/m2) - if (associated(fluxes%seaice_melt_heat)) & - fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) + ! sea ice and snow melt heat flux [W/m2] + if (associated(IOB%seaice_melt_heat)) & + fluxes%seaice_melt_heat(i,j) = G%mask2dT(i,j) * IOB%seaice_melt_heat(i-i0,j-j0) - ! water flux due to sea ice and snow melt (kg/m2/s) - if (associated(fluxes%seaice_melt)) & - fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) + ! water flux due to sea ice and snow melt [kg/m2/s] + if (associated(IOB%seaice_melt)) & + fluxes%seaice_melt(i,j) = G%mask2dT(i,j) * IOB%seaice_melt(i-i0,j-j0) ! latent heat flux (W/m^2) - ! old method, latent = IOB%q_flux(i-i0,j-j0)*CS%latent_heat_vapor - !if (associated(fluxes%latent)) & - ! fluxes%latent(i,j) = G%mask2dT(i,j) * IOB%latent_flux(i-i0,j-j0) - ! new method fluxes%latent(i,j) = 0.0 ! contribution from frozen ppt - if (associated(fluxes%fprec)) then + if (associated(IOB%fprec)) then fluxes%latent(i,j) = fluxes%latent(i,j) + IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion fluxes%latent_fprec_diag(i,j) = G%mask2dT(i,j) * IOB%fprec(i-i0,j-j0)*CS%latent_heat_fusion endif @@ -478,25 +498,43 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & if (associated(IOB%sw_flux_vis_dir)) & fluxes%sw_vis_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_vis_dif)) & fluxes%sw_vis_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_vis_dif(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dir)) & fluxes%sw_nir_dir(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dir(i-i0,j-j0) + if (associated(IOB%sw_flux_nir_dif)) & fluxes%sw_nir_dif(i,j) = G%mask2dT(i,j) * IOB%sw_flux_nir_dif(i-i0,j-j0) fluxes%sw(i,j) = fluxes%sw_vis_dir(i,j) + fluxes%sw_vis_dif(i,j) + & fluxes%sw_nir_dir(i,j) + fluxes%sw_nir_dif(i,j) - ! salt flux - ! more salt restoring logic - if (associated(fluxes%salt_flux)) & - fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) - IOB%salt_flux(i-i0,j-j0)) + enddo; enddo - if (associated(fluxes%salt_flux_in)) & - fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*(-IOB%salt_flux(i-i0,j-j0)) + ! applied surface pressure from atmosphere and cryosphere + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = MIN(fluxes%p_surf_full(i,j),CS%max_p_surf) + enddo; enddo + else + do j=js,je ; do i=is,ie + fluxes%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) + fluxes%p_surf(i,j) = fluxes%p_surf_full(i,j) + enddo; enddo + endif + fluxes%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. + endif - enddo; enddo + if (associated(IOB%salt_flux)) then + do j=js,je ; do i=is,ie + fluxes%salt_flux(i,j) = G%mask2dT(i,j)*(fluxes%salt_flux(i,j) + IOB%salt_flux(i-i0,j-j0)) + fluxes%salt_flux_in(i,j) = G%mask2dT(i,j)*( IOB%salt_flux(i-i0,j-j0) ) + enddo ; enddo + endif ! adjust the NET fresh-water flux to zero, if flagged if (CS%adjust_net_fresh_water_to_zero) then @@ -523,6 +561,10 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & endif endif + if (coupler_type_initialized(fluxes%tr_fluxes) .and. & + coupler_type_initialized(IOB%fluxes)) & + call coupler_type_copy_data(IOB%fluxes, fluxes%tr_fluxes) + if (CS%allow_flux_adjustments) then ! Apply adjustments to fluxes call apply_flux_adjustments(G, CS, Time, fluxes) @@ -535,8 +577,6 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & end subroutine convert_IOB_to_fluxes -!======================================================================= - !> This subroutine translates the Ice_ocean_boundary_type into a MOM !! mechanical forcing type, including changes of units, sign conventions, !! and putting the fields into arrays with MOM-standard halos. @@ -553,52 +593,53 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) type(surface_forcing_CS),pointer :: CS !< A pointer to the control structure returned by a !! previous call to surface_forcing_init. + ! local variables real, dimension(SZIB_(G),SZJB_(G)) :: & - taux_at_q, & ! Zonal wind stresses at q points (Pa) - tauy_at_q ! Meridional wind stresses at q points (Pa) + taux_at_q, & !< Zonal wind stresses at q points [Pa] + tauy_at_q !< Meridional wind stresses at q points [Pa] real, dimension(SZI_(G),SZJ_(G)) :: & - rigidity_at_h, & ! Ice rigidity at tracer points (m3 s-1) - taux_at_h, & ! Zonal wind stresses at h points (Pa) - tauy_at_h ! Meridional wind stresses at h points (Pa) - - real :: gustiness ! unresolved gustiness that contributes to ustar (Pa) - real :: Irho0 ! inverse of the mean density in (m^3/kg) - real :: taux2, tauy2 ! squared wind stresses (Pa^2) - real :: tau_mag ! magnitude of the wind stress (Pa) - real :: I_GEarth ! 1.0 / G%G_Earth (s^2/m) - real :: Kv_rho_ice ! (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) - real :: mass_ice ! mass of sea ice at a face (kg/m^2) - real :: mass_eff ! effective mass of sea ice for rigidity (kg/m^2) - - integer :: wind_stagger ! AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) + rigidity_at_h, & !< Ice rigidity at tracer points (m3 s-1) + taux_at_h, & !< Zonal wind stresses at h points [Pa] + tauy_at_h !< Meridional wind stresses at h points [Pa] + + real :: gustiness !< unresolved gustiness that contributes to ustar [Pa] + real :: Irho0 !< inverse of the mean density in (m^3/kg) + real :: taux2, tauy2 !< squared wind stresses (Pa^2) + real :: tau_mag !< magnitude of the wind stress [Pa] + real :: I_GEarth !< 1.0 / G%G_Earth (s^2/m) + real :: Kv_rho_ice !< (CS%kv_sea_ice / CS%density_sea_ice) ( m^5/(s*kg) ) + real :: mass_ice !< mass of sea ice at a face (kg/m^2) + real :: mass_eff !< effective mass of sea ice for rigidity (kg/m^2) + + integer :: wind_stagger !< AGRID, BGRID_NE, or CGRID_NE (integers from MOM_domains) integer :: i, j, is, ie, js, je, Isq, Ieq, Jsq, Jeq, i0, j0 integer :: isd, ied, jsd, jed, IsdB, IedB, JsdB, JedB, isr, ier, jsr, jer integer :: isc_bnd, iec_bnd, jsc_bnd, jec_bnd call cpu_clock_begin(id_clock_forcing) + isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) + jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) is = G%isc ; ie = G%iec ; js = G%jsc ; je = G%jec Isq = G%IscB ; Ieq = G%IecB ; Jsq = G%JscB ; Jeq = G%JecB isd = G%isd ; ied = G%ied ; jsd = G%jsd ; jed = G%jed IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isr = is-isd+1 ; ier = ie-isd+1 ; jsr = js-jsd+1 ; jer = je-jsd+1 - - !isc_bnd = index_bounds(1) ; iec_bnd = index_bounds(2) - !jsc_bnd = index_bounds(3) ; jec_bnd = index_bounds(4) - !if (is_root_pe()) write(*,*)'isc_bnd, jsc_bnd, iec_bnd, jec_bnd',isc_bnd, jsc_bnd, iec_bnd, jec_bnd !i0 = is - isc_bnd ; j0 = js - jsc_bnd - i0 = 0; j0 = 0 ! TODO: is this right? + i0 = 0; j0 = 0 Irho0 = 1.0/CS%Rho0 ! allocation and initialization if this is the first time that this ! mechanical forcing type has been used. if (.not.forces%initialized) then - call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., & - press=.true.) + + call allocate_mech_forcing(G, forces, stress=.true., ustar=.true., press=.true.) + call safe_alloc_ptr(forces%p_surf,isd,ied,jsd,jed) call safe_alloc_ptr(forces%p_surf_full,isd,ied,jsd,jed) + if (CS%rigid_sea_ice) then call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) @@ -607,29 +648,44 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) forces%initialized = .true. endif + if ( (associated(IOB%area_berg) .and. (.not. associated(forces%area_berg))) .or. & + (associated(IOB%mass_berg) .and. (.not. associated(forces%mass_berg))) ) & + call allocate_mech_forcing(G, forces, iceberg=.true.) + if (associated(IOB%ice_rigidity)) then + rigidity_at_h(:,:) = 0.0 + call safe_alloc_ptr(forces%rigidity_ice_u,IsdB,IedB,jsd,jed) + call safe_alloc_ptr(forces%rigidity_ice_v,isd,ied,JsdB,JedB) + endif + + forces%accumulate_rigidity = .true. ! Multiple components may contribute to rigidity. if (associated(forces%rigidity_ice_u)) forces%rigidity_ice_u(:,:) = 0.0 if (associated(forces%rigidity_ice_v)) forces%rigidity_ice_v(:,:) = 0.0 !applied surface pressure from atmosphere and cryosphere - !sea-level pressure (Pa) - do j=js,je ; do i=is,ie - if (associated(forces%p_surf_full) .and. associated(forces%p_surf)) then - forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) - - if (CS%max_p_surf >= 0.0) then + if (CS%use_limited_P_SSH) then + forces%p_surf_SSH => forces%p_surf + else + forces%p_surf_SSH => forces%p_surf_full + endif + if (associated(IOB%p)) then + if (CS%max_p_surf >= 0.0) then + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) forces%p_surf(i,j) = MIN(forces%p_surf_full(i,j),CS%max_p_surf) - else + enddo ; enddo + else + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = G%mask2dT(i,j) * IOB%p(i-i0,j-j0) forces%p_surf(i,j) = forces%p_surf_full(i,j) - endif - + enddo ; enddo endif - enddo; enddo - - if (CS%use_limited_P_SSH) then - forces%p_surf_SSH => forces%p_surf else - forces%p_surf_SSH => forces%p_surf_full + do j=js,je ; do i=is,ie + forces%p_surf_full(i,j) = 0.0 + forces%p_surf(i,j) = 0.0 + enddo ; enddo endif + forces%accumulate_p_surf = .true. ! Multiple components may contribute to surface pressure. ! GMM, CIME uses AGRID. All the BGRID_NE code can be cleaned later wind_stagger = AGRID @@ -645,6 +701,15 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) ! obtain fluxes from IOB; note the staggering of indices do j=js,je ; do i=is,ie + if (associated(IOB%area_berg)) & + forces%area_berg(i,j) = IOB%area_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%mass_berg)) & + forces%mass_berg(i,j) = IOB%mass_berg(i-i0,j-j0) * G%mask2dT(i,j) + + if (associated(IOB%ice_rigidity)) & + rigidity_at_h(i,j) = IOB%ice_rigidity(i-i0,j-j0) * G%mask2dT(i,j) + if (wind_stagger == BGRID_NE) then if (associated(IOB%u_flux)) taux_at_q(I,J) = IOB%u_flux(i-i0,j-j0) * CS%wind_stress_multiplier if (associated(IOB%v_flux)) tauy_at_q(I,J) = IOB%v_flux(i-i0,j-j0) * CS%wind_stress_multiplier @@ -662,7 +727,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) if (wind_stagger == BGRID_NE) then if (G%symmetric) & call fill_symmetric_edges(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) - call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE) + call pass_vector(taux_at_q, tauy_at_q, G%Domain, stagger=BGRID_NE, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -699,7 +764,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo; enddo elseif (wind_stagger == AGRID) then - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) + call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 @@ -727,7 +792,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) else ! C-grid wind stresses. if (G%symmetric) & call fill_symmetric_edges(forces%taux, forces%tauy, G%Domain) - call pass_vector(forces%taux, forces%tauy, G%Domain) + call pass_vector(forces%taux, forces%tauy, G%Domain, halo=1) do j=js,je ; do i=is,ie taux2 = 0.0 @@ -750,6 +815,18 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) endif ! endif for wind related fields ! sea ice related dynamic fields + if (associated(IOB%ice_rigidity)) then + call pass_var(rigidity_at_h, G%Domain, halo=1) + do I=is-1,ie ; do j=js,je + forces%rigidity_ice_u(I,j) = forces%rigidity_ice_u(I,j) + & + min(rigidity_at_h(i,j), rigidity_at_h(i+1,j)) + enddo ; enddo + do i=is,ie ; do J=js-1,je + forces%rigidity_ice_v(i,J) = forces%rigidity_ice_v(i,J) + & + min(rigidity_at_h(i,j), rigidity_at_h(i,j+1)) + enddo ; enddo + endif + if (CS%rigid_sea_ice) then call pass_var(forces%p_surf_full, G%Domain, halo=1) I_GEarth = 1.0 / G%G_Earth @@ -785,129 +862,52 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) call cpu_clock_end(id_clock_forcing) end subroutine convert_IOB_to_forces -!======================================================================= - -!> Allocates ice-ocean boundary type containers and sets to 0. -subroutine IOB_allocate(IOB, isc, iec, jsc, jec) - type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive - integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size - - allocate ( IOB% latent_flux (isc:iec,jsc:jec), & - IOB% rofl_flux (isc:iec,jsc:jec), & - IOB% rofi_flux (isc:iec,jsc:jec), & - IOB% u_flux (isc:iec,jsc:jec), & - IOB% v_flux (isc:iec,jsc:jec), & - IOB% t_flux (isc:iec,jsc:jec), & - IOB% seaice_melt_heat (isc:iec,jsc:jec),& - IOB% seaice_melt (isc:iec,jsc:jec), & - IOB% q_flux (isc:iec,jsc:jec), & - IOB% salt_flux (isc:iec,jsc:jec), & - IOB% lw_flux (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & - IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & - IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & - IOB% lprec (isc:iec,jsc:jec), & - IOB% fprec (isc:iec,jsc:jec), & - IOB% ustar_berg (isc:iec,jsc:jec), & - IOB% area_berg (isc:iec,jsc:jec), & - IOB% mass_berg (isc:iec,jsc:jec), & - IOB% calving (isc:iec,jsc:jec), & - IOB% runoff_hflx (isc:iec,jsc:jec), & - IOB% calving_hflx (isc:iec,jsc:jec), & - IOB% mi (isc:iec,jsc:jec), & - IOB% p (isc:iec,jsc:jec)) - - IOB%latent_flux = 0.0 - IOB%rofl_flux = 0.0 - IOB%rofi_flux = 0.0 - IOB%u_flux = 0.0 - IOB%v_flux = 0.0 - IOB%t_flux = 0.0 - IOB%seaice_melt_heat = 0.0 - IOB%seaice_melt = 0.0 - IOB%q_flux = 0.0 - IOB%salt_flux = 0.0 - IOB%lw_flux = 0.0 - IOB%sw_flux_vis_dir = 0.0 - IOB%sw_flux_vis_dif = 0.0 - IOB%sw_flux_nir_dir = 0.0 - IOB%sw_flux_nir_dif = 0.0 - IOB%lprec = 0.0 - IOB%fprec = 0.0 - IOB%ustar_berg = 0.0 - IOB%area_berg = 0.0 - IOB%mass_berg = 0.0 - IOB%calving = 0.0 - IOB%runoff_hflx = 0.0 - IOB%calving_hflx = 0.0 - IOB%mi = 0.0 - IOB%p = 0.0 - -end subroutine IOB_allocate - -!======================================================================= - -!> Adds flux adjustments obtained via data_override +!> Adds thermodynamic flux adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: -!! - taux_adj (Zonal wind stress delta, positive to the east, in Pa) -!! - tauy_adj (Meridional wind stress delta, positive to the north, in Pa) +!! - hflx_adj (Heat flux into the ocean, in W m-2) +!! - sflx_adj (Salt flux into the ocean, in kg salt m-2 s-1) +!! - prcme_adj (Fresh water flux into the ocean, in kg m-2 s-1) subroutine apply_flux_adjustments(G, CS, Time, fluxes) type(ocean_grid_type), intent(inout) :: G !< Ocean grid structure type(surface_forcing_CS), pointer :: CS !< Surface forcing control structure type(time_type), intent(in) :: Time !< Model time structure - type(forcing), optional, intent(inout) :: fluxes !< Surface fluxes structure + type(forcing), intent(inout) :: fluxes !< Surface fluxes structure ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h ! Fluxes at h points (W m-2 or kg m-2 s-1) + real, dimension(SZI_(G),SZJ_(G)) :: temp_at_h !< Fluxes at h points [W m-2 or kg m-2 s-1] integer :: isc, iec, jsc, jec, i, j - real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau - logical :: overrode_x, overrode_y, overrode_h + logical :: overrode_h - isc = G%isc; iec = G%iec - jsc = G%jsc; jec = G%jec + isc = G%isc; iec = G%iec ; jsc = G%jsc; jec = G%jec overrode_h = .false. call data_override('OCN', 'hflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif - - call pass_var(fluxes%heat_added, G%Domain) + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%heat_added(i,j) = fluxes%heat_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%heat_added, G%Domain) overrode_h = .false. call data_override('OCN', 'sflx_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%salt_flux_added(i,j) = fluxes%salt_flux_added(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%salt_flux_added, G%Domain) - call pass_var(fluxes%salt_flux_added, G%Domain) overrode_h = .false. - call data_override('OCN', 'prcme_adj', temp_at_h(isc:iec,jsc:jec), Time, override=overrode_h) - if (overrode_h) then - do j=G%jsc,G%jec ; do i=G%isc,G%iec - fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) - enddo; enddo - endif - - call pass_var(fluxes%vprec, G%Domain) + if (overrode_h) then ; do j=jsc,jec ; do i=isc,iec + fluxes%vprec(i,j) = fluxes%vprec(i,j) + temp_at_h(i,j)* G%mask2dT(i,j) + enddo ; enddo ; endif + ! Not needed? ! if (overrode_h) call pass_var(fluxes%vprec, G%Domain) end subroutine apply_flux_adjustments -!======================================================================= - !> Adds mechanical forcing adjustments obtained via data_override !! Component name is 'OCN' !! Available adjustments are: @@ -920,8 +920,8 @@ subroutine apply_force_adjustments(G, CS, Time, forces) type(mech_forcing), intent(inout) :: forces !< A structure with the driving mechanical forces ! Local variables - real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h ! Delta to zonal wind stress at h points (Pa) - real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h ! Delta to meridional wind stress at h points (Pa) + real, dimension(SZI_(G),SZJ_(G)) :: tempx_at_h !< Delta to zonal wind stress at h points [Pa] + real, dimension(SZI_(G),SZJ_(G)) :: tempy_at_h !< Delta to meridional wind stress at h points [Pa] integer :: isc, iec, jsc, jec, i, j real :: dLonDx, dLonDy, rDlon, cosA, sinA, zonal_tau, merid_tau @@ -966,54 +966,52 @@ subroutine apply_force_adjustments(G, CS, Time, forces) end subroutine apply_force_adjustments -!======================================================================= - -!> Saves restart fields associated with the forcing +!> Save any restart files associated with the surface forcing. subroutine forcing_save_restart(CS, G, Time, directory, time_stamped, & filename_suffix) - type(surface_forcing_CS), pointer :: CS !< pointer to the control structure - !! returned by a previous call to - !! surface_forcing_init + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned + !! by a previous call to surface_forcing_init type(ocean_grid_type), intent(inout) :: G !< The ocean's grid structure - type(time_type), intent(in) :: Time !< model time at this call - character(len=*), intent(in) :: directory !< optional directory into which - !! to write these restart files - logical, optional, intent(in) :: time_stamped !< If true, the restart file - !! names include a unique time - !! stamp - character(len=*), optional, intent(in) :: filename_suffix !< optional suffix - !! (e.g., a time-stamp) to append to the - !! restart file names + type(time_type), intent(in) :: Time !< The current model time + character(len=*), intent(in) :: directory !< The directory into which to write the + !! restart files + logical, optional, intent(in) :: time_stamped !< If true, the restart file names include + !! a unique time stamp. The default is false. + character(len=*), optional, intent(in) :: filename_suffix !< An optional suffix (e.g., a time- + !! stamp) to append to the restart file names. + if (.not.associated(CS)) return if (.not.associated(CS%restart_CSp)) return call save_restart(directory, Time, G, CS%restart_CSp, time_stamped) end subroutine forcing_save_restart -!======================================================================= - -!> Initializes surface forcing: get relevant parameters and allocate arrays. +!> Initialize the surface forcing, including setting parameters and allocating permanent memory. subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, restore_temp) type(time_type), intent(in) :: Time !< The current model time type(ocean_grid_type), intent(in) :: G !< The ocean's grid structure type(unit_scale_type), intent(in) :: US !< A dimensional unit scaling type type(param_file_type), intent(in) :: param_file !< A structure to parse for run-time parameters - type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate diagnostic output - type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the - !! control structure for this module - logical, optional, intent(in) :: restore_salt, restore_temp !< If present and true, - !! temp/salt restoring will be applied + type(diag_ctrl), target, intent(inout) :: diag !< A structure that is used to regulate + !! diagnostic output + type(surface_forcing_CS), pointer :: CS !< A pointer that is set to point to the control + !! structure for this module + logical, optional, intent(in) :: restore_salt !< If present and true surface salinity + !! restoring will be applied in this model. + logical, optional, intent(in) :: restore_temp !< If present and true surface temperature + !! restoring will be applied in this model. - ! local variables - real :: utide !< The RMS tidal velocity [m s-1]. + ! Local variables + real :: utide ! The RMS tidal velocity, in m s-1. type(directories) :: dirs logical :: new_sim, iceberg_flux_diags type(time_type) :: Time_frc 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) :: mdl = "ocn_comp_mct" ! This module's name. + character(len=40) :: mdl = "MOM_surface_forcing" ! This module's name. character(len=48) :: stagger + character(len=48) :: flnam character(len=240) :: basin_file integer :: i, j, isd, ied, jsd, jed @@ -1031,7 +1029,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, CS%diag => diag - call write_version_number (version) + call write_version_number(version) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") @@ -1151,12 +1149,15 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, basin_file = trim(CS%inputdir) // trim(basin_file) call safe_alloc_ptr(CS%basin_mask,isd,ied,jsd,jed) ; CS%basin_mask(:,:) = 1.0 if (CS%mask_srestore_marginal_seas) then - call read_data(basin_file,'basin',CS%basin_mask,domain=G%domain%mpp_domain,timelevel=1) + call MOM_read_data(basin_file,'basin',CS%basin_mask,G%domain, timelevel=1) do j=jsd,jed ; do i=isd,ied if (CS%basin_mask(i,j) >= 6.0) then ; CS%basin_mask(i,j) = 0.0 else ; CS%basin_mask(i,j) = 1.0 ; endif enddo ; enddo endif + call get_param(param_file, mdl, "MASK_SRESTORE", CS%mask_srestore, & + "If true, read a file (salt_restore_mask) containing "//& + "a mask for SSS restoring.", default=.false.) endif if (restore_temp) then @@ -1172,16 +1173,19 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "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. + ! 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, mdl, "MAX_DELTA_TRESTORE", CS%max_delta_trestore, & "The maximum sst difference used in restoring terms.", & units="degC ", default=999.0) + call get_param(param_file, mdl, "MASK_TRESTORE", CS%mask_trestore, & + "If true, read a file (temp_restore_mask) containing "//& + "a mask for SST restoring.", default=.false.) endif -! Optionally read tidal amplitude from input file [m s-1] on model grid. +! Optionally read tidal amplitude from input file (m s-1) on model grid. ! 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. @@ -1208,7 +1212,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (CS%read_TIDEAMP) then TideAmp_file = trim(CS%inputdir) // trim(TideAmp_file) - call read_data(TideAmp_file,'tideamp',CS%TKE_tidal,domain=G%domain%mpp_domain,timelevel=1) + call MOM_read_data(TideAmp_file,'tideamp',CS%TKE_tidal,G%domain,timelevel=1) do j=jsd, jed; do i=isd, ied utide = CS%TKE_tidal(i,j) CS%TKE_tidal(i,j) = G%mask2dT(i,j)*CS%Rho0*CS%cd_tides*(utide*utide*utide) @@ -1240,8 +1244,7 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call safe_alloc_ptr(CS%gust,isd,ied,jsd,jed) gust_file = trim(CS%inputdir) // trim(gust_file) - call read_data(gust_file,'gustiness',CS%gust,domain=G%domain%mpp_domain, & - timelevel=1) ! units should be Pa + call MOM_read_data(gust_file,'gustiness',CS%gust,G%domain, timelevel=1) ! units should be Pa endif ! See whether sufficiently thick sea ice should be treated as rigid. @@ -1279,11 +1282,21 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, if (present(restore_salt)) then ; if (restore_salt) then salt_file = trim(CS%inputdir) // trim(CS%salt_restore_file) CS%id_srestore = init_external_field(salt_file, CS%salt_restore_var_name, domain=G%Domain%mpp_domain) + call safe_alloc_ptr(CS%srestore_mask,isd,ied,jsd,jed); CS%srestore_mask(:,:) = 1.0 + if (CS%mask_srestore) then ! read a 2-d file containing a mask for restoring fluxes + flnam = trim(CS%inputdir) // 'salt_restore_mask.nc' + call MOM_read_data(flnam,'mask', CS%srestore_mask, G%domain, timelevel=1) + endif endif ; endif if (present(restore_temp)) then ; if (restore_temp) then temp_file = trim(CS%inputdir) // trim(CS%temp_restore_file) CS%id_trestore = init_external_field(temp_file, CS%temp_restore_var_name, domain=G%Domain%mpp_domain) + call safe_alloc_ptr(CS%trestore_mask,isd,ied,jsd,jed); CS%trestore_mask(:,:) = 1.0 + if (CS%mask_trestore) then ! read a 2-d file containing a mask for restoring fluxes + flnam = trim(CS%inputdir) // 'temp_restore_mask.nc' + call MOM_read_data(flnam, 'mask', CS%trestore_mask, G%domain, timelevel=1) + endif endif ; endif ! Set up any restart fields associated with the forcing. @@ -1311,16 +1324,14 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, call cpu_clock_end(id_clock_forcing) end subroutine surface_forcing_init -!======================================================================= - -!> Finalizes surface forcing: deallocate surface forcing control structure +!> Clean up and deallocate any memory associated with this module and its children. subroutine surface_forcing_end(CS, fluxes) - type(surface_forcing_CS), pointer :: CS - type(forcing), optional, intent(inout) :: fluxes -! Arguments: CS - A pointer to the control structure returned by a previous -! call to surface_forcing_init, it will be deallocated here. -! (inout) fluxes - A structure containing pointers to any possible -! forcing fields. Unused fields have NULL ptrs. + type(surface_forcing_CS), pointer :: CS !< A pointer to the control structure returned by + !! a previous call to surface_forcing_init, it will + !! be deallocated here. + type(forcing), optional, intent(inout) :: fluxes !< A structure containing pointers to all + !! possible mass, heat or salt flux forcing fields. + !! If present, it will be deallocated here. if (present(fluxes)) call deallocate_forcing_type(fluxes) @@ -1331,42 +1342,44 @@ subroutine surface_forcing_end(CS, fluxes) end subroutine surface_forcing_end -!======================================================================= - +!> Write out a set of messages with checksums of the fields in an ice_ocen_boundary type subroutine ice_ocn_bnd_type_chksum(id, timestep, iobt) - character(len=*), intent(in) :: id - integer , intent(in) :: timestep - type(ice_ocean_boundary_type), intent(in) :: iobt + character(len=*), intent(in) :: id !< An identifying string for this call + integer, intent(in) :: timestep !< The number of elapsed timesteps + type(ice_ocean_boundary_type), & + intent(in) :: iobt !< An ice-ocean boundary type with fluxes to drive the + !! ocean in a coupled model whose checksums are reported + + ! local variables integer :: n,m, outunit outunit = stdout() write(outunit,*) "BEGIN CHECKSUM(ice_ocean_boundary_type):: ", id, timestep - write(outunit,100) 'iobt%u_flux ', mpp_chksum( iobt%u_flux ) - write(outunit,100) 'iobt%v_flux ', mpp_chksum( iobt%v_flux ) - write(outunit,100) 'iobt%t_flux ', mpp_chksum( iobt%t_flux ) - write(outunit,100) 'iobt%seaice_melt_heat', mpp_chksum( iobt%seaice_melt_heat) - write(outunit,100) 'iobt%seaice_melt ', mpp_chksum( iobt%seaice_melt ) - write(outunit,100) 'iobt%q_flux ', mpp_chksum( iobt%q_flux ) - write(outunit,100) 'iobt%rofl_flux ', mpp_chksum( iobt%rofl_flux ) - write(outunit,100) 'iobt%rofi_flux ', mpp_chksum( iobt%rofi_flux ) - write(outunit,100) 'iobt%salt_flux ', mpp_chksum( iobt%salt_flux ) - write(outunit,100) 'iobt%lw_flux ', mpp_chksum( iobt%lw_flux ) - write(outunit,100) 'iobt%sw_flux_vis_dir ', mpp_chksum( iobt%sw_flux_vis_dir ) - write(outunit,100) 'iobt%sw_flux_vis_dif ', mpp_chksum( iobt%sw_flux_vis_dif ) - write(outunit,100) 'iobt%sw_flux_nir_dir ', mpp_chksum( iobt%sw_flux_nir_dir ) - write(outunit,100) 'iobt%sw_flux_nir_dif ', mpp_chksum( iobt%sw_flux_nir_dif ) - write(outunit,100) 'iobt%lprec ', mpp_chksum( iobt%lprec ) - write(outunit,100) 'iobt%fprec ', mpp_chksum( iobt%fprec ) - write(outunit,100) 'iobt%calving ', mpp_chksum( iobt%calving ) - write(outunit,100) 'iobt%p ', mpp_chksum( iobt%p ) + write(outunit,100) 'iobt%u_flux ' , mpp_chksum( iobt%u_flux ) + write(outunit,100) 'iobt%v_flux ' , mpp_chksum( iobt%v_flux ) + write(outunit,100) 'iobt%t_flux ' , mpp_chksum( iobt%t_flux ) + write(outunit,100) 'iobt%q_flux ' , mpp_chksum( iobt%q_flux ) + write(outunit,100) 'iobt%salt_flux ' , mpp_chksum( iobt%salt_flux ) + write(outunit,100) 'iobt%seaice_melt_heat' , mpp_chksum( iobt%seaice_melt_heat) + write(outunit,100) 'iobt%seaice_melt ' , mpp_chksum( iobt%seaice_melt ) + write(outunit,100) 'iobt%lw_flux ' , mpp_chksum( iobt%lw_flux ) + write(outunit,100) 'iobt%sw_flux_vis_dir' , mpp_chksum( iobt%sw_flux_vis_dir) + write(outunit,100) 'iobt%sw_flux_vis_dif' , mpp_chksum( iobt%sw_flux_vis_dif) + write(outunit,100) 'iobt%sw_flux_nir_dir' , mpp_chksum( iobt%sw_flux_nir_dir) + write(outunit,100) 'iobt%sw_flux_nir_dif' , mpp_chksum( iobt%sw_flux_nir_dif) + write(outunit,100) 'iobt%lprec ' , mpp_chksum( iobt%lprec ) + write(outunit,100) 'iobt%fprec ' , mpp_chksum( iobt%fprec ) + write(outunit,100) 'iobt%runoff ' , mpp_chksum( iobt%runoff ) + write(outunit,100) 'iobt%calving ' , mpp_chksum( iobt%calving ) + write(outunit,100) 'iobt%p ' , mpp_chksum( iobt%p ) if (associated(iobt%ustar_berg)) & - write(outunit,100) 'iobt%ustar_berg ', mpp_chksum( iobt%ustar_berg ) + write(outunit,100) 'iobt%ustar_berg ' , mpp_chksum( iobt%ustar_berg ) if (associated(iobt%area_berg)) & - write(outunit,100) 'iobt%area_berg ', mpp_chksum( iobt%area_berg ) + write(outunit,100) 'iobt%area_berg ' , mpp_chksum( iobt%area_berg ) if (associated(iobt%mass_berg)) & - write(outunit,100) 'iobt%mass_berg ', mpp_chksum( iobt%mass_berg ) + write(outunit,100) 'iobt%mass_berg ' , mpp_chksum( iobt%mass_berg ) 100 FORMAT(" CHECKSUM::",A20," = ",Z20) call coupler_type_write_chksums(iobt%fluxes, outunit, 'iobt%') diff --git a/config_src/mct_driver/ocn_cap_methods.F90 b/config_src/mct_driver/ocn_cap_methods.F90 index 7723f51a6c..7e06b014d4 100644 --- a/config_src/mct_driver/ocn_cap_methods.F90 +++ b/config_src/mct_driver/ocn_cap_methods.F90 @@ -71,9 +71,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! sensible heat flux (W/m2) ice_ocean_boundary%t_flux(i,j) = x2o(ind%x2o_Foxx_sen,k) - ! latent heat flux (W/m^2) - ice_ocean_boundary%latent_flux(i,j) = x2o(ind%x2o_Foxx_lat,k) - ! snow&ice melt heat flux (W/m^2) ice_ocean_boundary%seaice_melt_heat(i,j) = x2o(ind%x2o_Fioi_melth,k) @@ -89,8 +86,8 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, ! surface pressure ice_ocean_boundary%p(i,j) = x2o(ind%x2o_Sa_pslv,k) * GRID%mask2dT(i,j) - ! salt flux (minus sign needed here -GMM) - ice_ocean_boundary%salt_flux(i,j) = -x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j) + ! salt flux + ice_ocean_boundary%salt_flux(i,j) = x2o(ind%x2o_Fioi_salt,k) * GRID%mask2dT(i,j) ! 1) visible, direct shortwave (W/m2) ! 2) visible, diffuse shortwave (W/m2) @@ -127,8 +124,6 @@ subroutine ocn_import(x2o, ind, grid, ice_ocean_boundary, ocean_public, logunit, day,secs,j,i,ice_ocean_boundary%seaice_melt_heat(i,j) write(logunit,F01)'import: day, secs, j, i, seaice_melt = ',& day,secs,j,i,ice_ocean_boundary%seaice_melt(i,j) - write(logunit,F01)'import: day, secs, j, i, latent_flux = ',& - day,secs,j,i,ice_ocean_boundary%latent_flux(i,j) write(logunit,F01)'import: day, secs, j, i, runoff = ',& day,secs,j,i,ice_ocean_boundary%rofl_flux(i,j) + ice_ocean_boundary%rofi_flux(i,j) write(logunit,F01)'import: day, secs, j, i, psurf = ',& diff --git a/config_src/mct_driver/ocn_comp_mct.F90 b/config_src/mct_driver/ocn_comp_mct.F90 index 5698335b6f..8d9133d08b 100644 --- a/config_src/mct_driver/ocn_comp_mct.F90 +++ b/config_src/mct_driver/ocn_comp_mct.F90 @@ -24,8 +24,6 @@ module ocn_comp_mct shr_file_getLogUnit, shr_file_getLogLevel, & shr_file_setLogUnit, shr_file_setLogLevel -use MOM_surface_forcing, only: IOB_allocate, ice_ocean_boundary_type - ! MOM6 modules use MOM, only: extract_surface_state use MOM_variables, only: surface @@ -49,7 +47,7 @@ module ocn_comp_mct use MOM_ocean_model, only: ocean_public_type, ocean_state_type use MOM_ocean_model, only: ocean_model_init , update_ocean_model, ocean_model_end use MOM_ocean_model, only: convert_state_to_ocean_type -use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart +use MOM_surface_forcing, only: surface_forcing_CS, forcing_save_restart, ice_ocean_boundary_type use ocn_cap_methods, only: ocn_import, ocn_export ! FMS modules @@ -813,4 +811,61 @@ end subroutine ocean_model_init_sfc !! CO2 !! DMS +!> Allocates ice-ocean boundary type containers and sets to 0. +subroutine IOB_allocate(IOB, isc, iec, jsc, jec) + type(ice_ocean_boundary_type), intent(inout) :: IOB !< An ice-ocean boundary type with fluxes to drive + integer, intent(in) :: isc, iec, jsc, jec !< The ocean's local grid size + + allocate ( IOB% rofl_flux (isc:iec,jsc:jec), & + IOB% rofi_flux (isc:iec,jsc:jec), & + IOB% u_flux (isc:iec,jsc:jec), & + IOB% v_flux (isc:iec,jsc:jec), & + IOB% t_flux (isc:iec,jsc:jec), & + IOB% seaice_melt_heat (isc:iec,jsc:jec),& + IOB% seaice_melt (isc:iec,jsc:jec), & + IOB% q_flux (isc:iec,jsc:jec), & + IOB% salt_flux (isc:iec,jsc:jec), & + IOB% lw_flux (isc:iec,jsc:jec), & + IOB% sw_flux_vis_dir (isc:iec,jsc:jec), & + IOB% sw_flux_vis_dif (isc:iec,jsc:jec), & + IOB% sw_flux_nir_dir (isc:iec,jsc:jec), & + IOB% sw_flux_nir_dif (isc:iec,jsc:jec), & + IOB% lprec (isc:iec,jsc:jec), & + IOB% fprec (isc:iec,jsc:jec), & + IOB% ustar_berg (isc:iec,jsc:jec), & + IOB% area_berg (isc:iec,jsc:jec), & + IOB% mass_berg (isc:iec,jsc:jec), & + IOB% calving (isc:iec,jsc:jec), & + IOB% runoff_hflx (isc:iec,jsc:jec), & + IOB% calving_hflx (isc:iec,jsc:jec), & + IOB% mi (isc:iec,jsc:jec), & + IOB% p (isc:iec,jsc:jec)) + + IOB%rofl_flux = 0.0 + IOB%rofi_flux = 0.0 + IOB%u_flux = 0.0 + IOB%v_flux = 0.0 + IOB%t_flux = 0.0 + IOB%seaice_melt_heat = 0.0 + IOB%seaice_melt = 0.0 + IOB%q_flux = 0.0 + IOB%salt_flux = 0.0 + IOB%lw_flux = 0.0 + IOB%sw_flux_vis_dir = 0.0 + IOB%sw_flux_vis_dif = 0.0 + IOB%sw_flux_nir_dir = 0.0 + IOB%sw_flux_nir_dif = 0.0 + IOB%lprec = 0.0 + IOB%fprec = 0.0 + IOB%ustar_berg = 0.0 + IOB%area_berg = 0.0 + IOB%mass_berg = 0.0 + IOB%calving = 0.0 + IOB%runoff_hflx = 0.0 + IOB%calving_hflx = 0.0 + IOB%mi = 0.0 + IOB%p = 0.0 + +end subroutine IOB_allocate + end module ocn_comp_mct diff --git a/config_src/nuopc_driver/MOM_ocean_model.F90 b/config_src/nuopc_driver/MOM_ocean_model.F90 index abe583ffcc..f0ba14ac1d 100644 --- a/config_src/nuopc_driver/MOM_ocean_model.F90 +++ b/config_src/nuopc_driver/MOM_ocean_model.F90 @@ -11,57 +11,57 @@ module MOM_ocean_model ! This code is a stop-gap wrapper of the MOM6 code to enable it to be called ! in the same way as MOM4. -use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end -use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization -use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized -use MOM, only : get_ocean_stocks, 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 -use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE -use MOM_domains, only : TO_ALL, Omit_Corners -use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe -use MOM_error_handler, only : callTree_enter, callTree_leave -use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type -use MOM_forcing_type, only : allocate_forcing_type -use MOM_forcing_type, only : forcing, mech_forcing -use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields -use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing -use MOM_forcing_type, only : set_derived_forcing_fields -use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags -use MOM_get_input, only : Get_MOM_Input, directories -use MOM_grid, only : ocean_grid_type -use MOM_io, only : close_file, file_exists, read_data, write_version_number -use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS -use MOM_restart, only : MOM_restart_CS, save_restart -use MOM_string_functions, only : uppercase -use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes -use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum -use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS -use MOM_surface_forcing, only : forcing_save_restart -use MOM_time_manager, only : time_type, get_time, set_time, operator(>) -use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) -use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) -use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real +use MOM, only : initialize_MOM, step_MOM, MOM_control_struct, MOM_end +use MOM, only : extract_surface_state, allocate_surface_state, finish_MOM_initialization +use MOM, only : get_MOM_state_elements, MOM_state_is_synchronized +use MOM, only : get_ocean_stocks, 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 +use MOM_domains, only : pass_var, pass_vector, AGRID, BGRID_NE, CGRID_NE +use MOM_domains, only : TO_ALL, Omit_Corners +use MOM_error_handler, only : MOM_error, FATAL, WARNING, is_root_pe +use MOM_error_handler, only : callTree_enter, callTree_leave +use MOM_file_parser, only : get_param, log_version, close_param_file, param_file_type +use MOM_forcing_type, only : allocate_forcing_type +use MOM_forcing_type, only : forcing, mech_forcing +use MOM_forcing_type, only : forcing_accumulate, copy_common_forcing_fields +use MOM_forcing_type, only : copy_back_forcing_fields, set_net_mass_forcing +use MOM_forcing_type, only : set_derived_forcing_fields +use MOM_forcing_type, only : forcing_diagnostics, mech_forcing_diags +use MOM_get_input, only : Get_MOM_Input, directories +use MOM_grid, only : ocean_grid_type +use MOM_io, only : close_file, file_exists, read_data, write_version_number +use MOM_marine_ice, only : iceberg_forces, iceberg_fluxes, marine_ice_init, marine_ice_CS +use MOM_restart, only : MOM_restart_CS, save_restart +use MOM_string_functions, only : uppercase +use MOM_surface_forcing, only : surface_forcing_init, convert_IOB_to_fluxes +use MOM_surface_forcing, only : convert_IOB_to_forces, ice_ocn_bnd_type_chksum +use MOM_surface_forcing, only : ice_ocean_boundary_type, surface_forcing_CS +use MOM_surface_forcing, only : forcing_save_restart +use MOM_time_manager, only : time_type, get_time, set_time, operator(>) +use MOM_time_manager, only : operator(+), operator(-), operator(*), operator(/) +use MOM_time_manager, only : operator(/=), operator(<=), operator(>=) +use MOM_time_manager, only : operator(<), real_to_time_type, time_type_to_real use MOM_tracer_flow_control, only : call_tracer_register, tracer_flow_control_init use MOM_tracer_flow_control, only : call_tracer_flux_init use MOM_unit_scaling, only : unit_scale_type -use MOM_variables, only : surface -use MOM_verticalGrid, only : verticalGrid_type -use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS -use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart -use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type -use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums -use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data -use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data -use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain -use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain -use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux -use fms_mod, only : stdout -use mpp_mod, only : mpp_chksum -use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct -use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init -use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves +use MOM_variables, only : surface +use MOM_verticalGrid, only : verticalGrid_type +use MOM_ice_shelf, only : initialize_ice_shelf, shelf_calc_flux, ice_shelf_CS +use MOM_ice_shelf, only : add_shelf_forces, ice_shelf_end, ice_shelf_save_restart +use coupler_types_mod, only : coupler_1d_bc_type, coupler_2d_bc_type +use coupler_types_mod, only : coupler_type_spawn, coupler_type_write_chksums +use coupler_types_mod, only : coupler_type_initialized, coupler_type_copy_data +use coupler_types_mod, only : coupler_type_set_diags, coupler_type_send_data +use mpp_domains_mod, only : domain2d, mpp_get_layout, mpp_get_global_domain +use mpp_domains_mod, only : mpp_define_domains, mpp_get_compute_domain, mpp_get_data_domain +use atmos_ocean_fluxes_mod, only : aof_set_coupler_flux +use fms_mod, only : stdout +use mpp_mod, only : mpp_chksum +use MOM_EOS, only : gsw_sp_from_sr, gsw_pt_from_ct +use MOM_wave_interface, only: wave_parameters_CS, MOM_wave_interface_init +use MOM_wave_interface, only: MOM_wave_interface_init_lite, Update_Surface_Waves #include @@ -260,7 +260,6 @@ subroutine ocean_model_init(Ocean_sfc, OS, Time_init, Time_in, gas_fields_ocn, i integer :: secs, days type(param_file_type) :: param_file !< A structure to parse for run-time parameters logical :: use_temperature - type(time_type) :: dt_geometric, dt_savedays, dt_from_base call callTree_enter("ocean_model_init(), ocean_model_MOM.F90") if (associated(OS)) then @@ -476,7 +475,7 @@ subroutine update_ocean_model(Ice_ocean_boundary, OS, Ocean_sfc, & integer :: secs, days integer :: is, ie, js, je - call callTree_enter("update_ocean_model(), ocean_model_MOM.F90") + call callTree_enter("update_ocean_model(), MOM_ocean_model.F90") call get_time(Ocean_coupling_time_step, secs, days) dt_coupling = 86400.0*real(days) + real(secs) diff --git a/config_src/nuopc_driver/MOM_surface_forcing.F90 b/config_src/nuopc_driver/MOM_surface_forcing.F90 index da7956feeb..26121ff62d 100644 --- a/config_src/nuopc_driver/MOM_surface_forcing.F90 +++ b/config_src/nuopc_driver/MOM_surface_forcing.F90 @@ -222,7 +222,7 @@ subroutine convert_IOB_to_fluxes(IOB, fluxes, index_bounds, Time, G, US, CS, & logical, optional, intent(in) :: restore_salt !< If true, salinity is restored to a target value. logical, optional, intent(in) :: restore_temp !< If true, temperature is restored to a target value. - ! local varibles + ! local variables real, dimension(SZI_(G),SZJ_(G)) :: & data_restore, & !< The surface value toward which to restore [g/kg or degC] SST_anom, & !< Instantaneous sea surface temperature anomalies from a target value [deg C] @@ -767,12 +767,7 @@ subroutine convert_IOB_to_forces(IOB, forces, index_bounds, Time, G, US, CS) enddo ; enddo elseif (wind_stagger == AGRID) then - !TODO: which one of these is correct? -#ifdef CESMCOUPLED - call pass_vector(taux_at_h, tauy_at_h, G%Domain,stagger=AGRID) -#else call pass_vector(taux_at_h, tauy_at_h, G%Domain, To_All+Omit_Corners, stagger=AGRID, halo=1) -#endif do j=js,je ; do I=Isq,Ieq forces%taux(I,j) = 0.0 From 562297c83a9841751ef2942b946b95313aee2267 Mon Sep 17 00:00:00 2001 From: Mariana Vertenstein Date: Tue, 16 Jul 2019 18:16:06 -0600 Subject: [PATCH 6/6] more changes to have minimal differences between nuopc and mct --- config_src/mct_driver/MOM_surface_forcing.F90 | 8 -------- 1 file changed, 8 deletions(-) diff --git a/config_src/mct_driver/MOM_surface_forcing.F90 b/config_src/mct_driver/MOM_surface_forcing.F90 index 0fc0efe532..cf1461467c 100644 --- a/config_src/mct_driver/MOM_surface_forcing.F90 +++ b/config_src/mct_driver/MOM_surface_forcing.F90 @@ -66,9 +66,6 @@ module MOM_surface_forcing logical :: use_temperature !! If true, temp and saln used as state variables real :: wind_stress_multiplier!< A multiplier applied to incoming wind stress (nondim). - ! smg: remove when have A=B code reconciled - logical :: bulkmixedlayer !< If true, model based on bulk mixed layer code - real :: Rho0 !< Boussinesq reference density [kg/m^3] real :: area_surf = -1.0 !< total ocean surface area [m^2] real :: latent_heat_fusion !< latent heat of fusion [J/kg] @@ -1093,11 +1090,6 @@ subroutine surface_forcing_init(Time, G, US, param_file, diag, CS, restore_salt, "limited by max_p_surf instead of the full atmospheric "//& "pressure.", default=.true.) -! 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, mdl, "BULKMIXEDLAYER", CS%bulkmixedlayer, & - default=CS%use_temperature,do_not_log=.true.) - call get_param(param_file, mdl, "WIND_STAGGER", stagger, & "A case-insensitive character string to indicate the "//& "staggering of the input wind stress field. Valid "//&